I'm trying to color rows of data based on some key terms in column A. Some rows need to be green and some rows need to be red.
I found this online but when I run it nothing happens on the sheet. I don't really know why or how to fix it. This is the version from my excel sheet, so it has all my info in it.
Public Sub ColorCHange2()
    Dim mapping As Object, itm As Variant
    
    Set mapping = CreateObject("Scripting.Dictionary")
    
    mapping(XlRgbColor.rgbLightPink) = Array("exclude from emails","exclude from listings")
    mapping(XlRgbColor.rgbLightGreen) = Array("include in billing list","include in emails")
    
    Application.ScreenUpdating = False
    Sheet1.AutoFilterMode = False
    With Sheet1.UsedRange
        .Interior.ColorIndex = xlColorIndexNone
        For Each itm In mapping
            .AutoFilter Field:=1, Criterial1:=mapping(itm), Operator:=xlFilterValues
            .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Interiror.Color = itm
            
        Next
        .AutoFiler
    End With
    Application.ScreenUpdating = True
End Sub
                Fixing your typos and the the fact your code doesn't only color visible cells post-filter...
Public Sub ColorCHange2()
    Dim mapping As Object, itm As Variant, rngVis As Range
    
    Set mapping = CreateObject("Scripting.Dictionary")
    
    mapping(XlRgbColor.rgbLightPink) = Array("exclude from emails", "exclude from listings")
    mapping(XlRgbColor.rgbLightGreen) = Array("include in billing list", "include in emails")
    
    Application.ScreenUpdating = False
    Sheet1.AutoFilterMode = False
    With Sheet1.UsedRange
        .Interior.ColorIndex = xlColorIndexNone
        For Each itm In mapping
            .AutoFilter Field:=1, Criteria1:=mapping(itm), Operator:=xlFilterValues
            Set rngVis = Nothing
            On Error Resume Next
            Set rngVis = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rngVis Is Nothing Then rngVis.Interior.Color = itm
        Next
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub
                        If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With