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