E
excelent
Hi experts
Code below finds and marks cells red if value is uniqus
Problem is that if i select a large range i cant se all red-marked cells
Is there a way to scroll window while code is running ?
Sub RemoveUniqs()
Dim rng As Range
Dim rng2 As Range
Set rng = Selection
rng.Interior.ColorIndex = xlNone
For Each c In rng
If WorksheetFunction.CountIf(rng, c.Value) = 1 Then
If rng2 Is Nothing Then
Set rng2 = c
Else
Set rng2 = Application.Union(rng2, c)
End If
End If
Next
rng2.Interior.ColorIndex = 3
Title = " Uniqs value is colored red ! what now ?"
choice1 = "Type 1 Clear value"
choice2 = "Type 2 Clear value and move cells up"
choice3 = "Type 3 Delete entire row"
choice = InputBox("" & choice1 & Chr(10) & choice2 & Chr(10) & choice3 & "",
Title)
If choice = 1 Then rng2 = ""
If choice = 2 Then rng2.Delete Shift:=xlUp
If choice = 3 Then rng2.EntireRow.Delete
End Sub
Code below finds and marks cells red if value is uniqus
Problem is that if i select a large range i cant se all red-marked cells
Is there a way to scroll window while code is running ?
Sub RemoveUniqs()
Dim rng As Range
Dim rng2 As Range
Set rng = Selection
rng.Interior.ColorIndex = xlNone
For Each c In rng
If WorksheetFunction.CountIf(rng, c.Value) = 1 Then
If rng2 Is Nothing Then
Set rng2 = c
Else
Set rng2 = Application.Union(rng2, c)
End If
End If
Next
rng2.Interior.ColorIndex = 3
Title = " Uniqs value is colored red ! what now ?"
choice1 = "Type 1 Clear value"
choice2 = "Type 2 Clear value and move cells up"
choice3 = "Type 3 Delete entire row"
choice = InputBox("" & choice1 & Chr(10) & choice2 & Chr(10) & choice3 & "",
Title)
If choice = 1 Then rng2 = ""
If choice = 2 Then rng2.Delete Shift:=xlUp
If choice = 3 Then rng2.EntireRow.Delete
End Sub