Sub test() Dim x, cDup, lRow As Integer, skipDup As String lRow = Range("B1").End(xlDown).Row x = 1 cDup = 0 Do x = x + 1 If Cells(x, "B").Value = Cells(x - 1, "B").Value And skipDup <> Cells(x, "B").Value Then cDup = cDup + 1 skipDup = Cells(x, "B").Value End If Loop Until x = lRow + 1 MsgBox "Column B contains " & cDup & " Duplicates." End Sub
Sub ColorRows() Dim lRow, x As Integer lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Rows(x).Interior.ColorIndex = 34 Loop1: Do x = x + 1 If Cells(x, "B").Value = Cells(x - 1, "B").Value Then Rows(x).Interior.ColorIndex = 34 Else: Rows(x).Interior.ColorIndex = 15 GoTo Loop2 End If Loop Until x = lRow Loop2: Do x = x + 1 If Cells(x, "B").Value = Cells(x - 1, "B").Value Then Rows(x).Interior.ColorIndex = 15 Else: Rows(x).Interior.ColorIndex = 34 GoTo Loop1 End If Loop Until x = lRow End Sub
Sub ColorRows() Dim lRow, x As Long lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Rows(x).Interior.ColorIndex = 34 Loop1: Do x = x + 1 If Cells(x, "B").Value = Cells(x - 1, "B").Value Then Rows(x).Interior.ColorIndex = 34 Else: Rows(x).Interior.ColorIndex = 15 If x = lRow Then Exit Sub GoTo Loop2 End If Loop Until x = lRow Exit Sub Loop2: Do x = x + 1 If Cells(x, "B").Value = Cells(x - 1, "B").Value Then Rows(x).Interior.ColorIndex = 15 Else: Rows(x).Interior.ColorIndex = 34 If x = lRow Then Exit Sub GoTo Loop1 End If Loop Until x = lRow End Sub