Option Explicit Sub Test() Dim ar As Variant, i As Integer ar = [{"J1","J2","J3";6,4,8}] Application.ScreenUpdating = False For i = 1 To UBound(ar, 2) With Sheet1.Range("A1", Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp)) .AutoFilter 1, ar(1, i) .Columns("A:P").Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = ar(2, i) .AutoFilter End With Next i Application.ScreenUpdating = True End Sub
Option Compare Text Sub TestAgain() Dim c As Range, lr As Long lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False Sheet1.Range("A2:P2").Interior.ColorIndex = 6 For Each c In Sheet1.Range("A3:A" & lr) Range(Cells(c.Row, "A"), Cells(c.Row, "P")).Interior.ColorIndex = xlNone If c.Value = c.Offset(-1).Value Then Range(Cells(c.Row, "A"), Cells(c.Row, "P")).Interior.ColorIndex = 6 Else Range(Cells(c.Row, "A"), Cells(c.Row, "P")).Interior.ColorIndex = 45 End If Next c Application.ScreenUpdating = True End Sub
Sub TestAgain() Dim c As Range, lr As Long, mColorIndex As Integer lr = Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False mColorIndex = 6 Range("A2:P2").Interior.ColorIndex = mColorIndex For Each c In Range("A3:A" & lr) Range(Cells(c.Row, "A"), Cells(c.Row, "P")).Interior.ColorIndex = xlNone If c.Value <> c.Offset(-1).Value Then If mColorIndex = 6 Then mColorIndex = 45 Else mColorIndex = 6 End If End If Range(Cells(c.Row, "A"), Cells(c.Row, "P")).Interior.ColorIndex = mColorIndex Next c Application.ScreenUpdating = True End Sub
DON'T MISS