Step thru Row No & Array Match
Hi Mark,
Am Mon, 27 Aug 2018 05:56:26 -0700 (PDT) schrieb Living the Dream:
Sub Color_Me()
try:
Sub Color_Me()
Dim Color1 As Long, Color2 As Long, Color3 As Long, Color4 As Long, Color5 As Long, Color6 As Long, Color7 As Long
Dim varDC As Variant, varColor As Variant
Dim L_Row As Long
Dim i As Integer
Const myStr = "HDC,LDC,NDC,RDC,SDC,SSl,VPS"
varDC = Split(myStr, ",")
Color1 = RGB(255, 255, 0): Color2 = RGB(51, 204, 255)
Color3 = RGB(153, 153, 153): Color4 = RGB(153, 255, 204)
Color5 = RGB(255, 102, 0): Color6 = RGB(255, 102, 255)
Color7 = RGB(51, 51, 153)
varColor = Array(Color1, Color2, Color3, Color4, Color5, Color6, Color7)
With ActiveSheet
L_Row = .Cells(.Rows.Count, "O").End(xlUp).Row
For i = LBound(varDC) To UBound(varDC)
If Application.CountIf(.Range("F2:F" & L_Row), varDC(i)) 0 Then
.Range("A1:O" & L_Row).AutoFilter , field:=6,
Criteria1:=varDC(i)
.Range("A2:O" &
L_Row).SpecialCells(xlCellTypeVisible).Interior.Co lor = varColor(i)
.Range("A1:O" & L_Row).AutoFilter field:=6
End If
Next
End With
End Sub
Regards
Claus B.
--
Windows10
Office 2016
|