Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Color Excel rows based on text cells

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
like image 507
basic math Avatar asked Sep 12 '25 17:09

basic math


1 Answers

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
like image 66
Tim Williams Avatar answered Sep 14 '25 11:09

Tim Williams