Excel VBA highlighting macro

Question

I have this Excel macro I created to highlight all instances of a number if at least one instance is already highlighted before running the macro.

Sub highlightXIDs()
    Dim prods As Object: Set prods = CreateObject("Scripting.Dictionary")
    Dim lastRow As Long: lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Dim tRange As Range

    For Each tRange In ActiveSheet.Range("A2:A" & lastRow)
        If tRange.Interior.ColorIndex <> xlNone Then prods.Add Key:=tRange.Value, Item:=tRange.Interior.Color
    Next

    Dim prod As Variant, xidMap As Object
    Set xidMap = getXidMap(ActiveSheet.Range("A2:A" & lastRow))
    For Each prod In prods.keys
        xidMap(prod).EntireRow.Columns("A").Interior.Color = prods.Item(prod)
    Next prod
End Sub

'get a "map" of each unique xid value to the rows containing it
Function getXidMap(rng As Range) As Object
    Dim rv As Object, c As Range, currVal, cStart, i, tmp
    Set rv = CreateObject("scripting.dictionary")
    For Each c In rng.Cells
        tmp = c.Value
        If Len(tmp) > 0 Then
            If rv.exists(tmp) Then
                Set rv(tmp) = Application.Union(c, rv(tmp))
            Else
                rv.Add tmp, c
            End If
        End If
    Next c
    Set getXidMap = rv
End Function

Before:

After:

1. Is this an efficient use of the included vba objects or should I change something?

2. For the line where I check the cell color, which would be more accurate/efficient in finding any cell that has fill color (excluding conditional formatting):

   .Interior.ColorIndex <> xlNone
   

   Or

   .Interior.Color <> -4142
   

   Or would these both work the same with the same amount of accuracy?

Answer 1

I'm going to talk about variable naming. I can't read your code and understand what's happening which indicates that your code isn't self-explanatory. One step in accomplishing that is to give variables meaningful names:

lastRow is good! Otherwise..

prods - what is this? a dictionary of product keys? why not productList or something similar?

prod how is this different than prods? Should it be productListKey?

tRange, rv, c, i and tmp - I have no idea what they should be doing - except for i because it's pretty standard.

cStart, currVal and i - you never use them. But if you did - why not just use the entire word for the description? currentValue and cellStart

Speaking of currVal, cStart, i and tmp - When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

What is rv anyway?

Also you are using (rng as Range) in your function - but you're passing it ByRef by default. I don't see any need to do that, so ByVal testRange as Range would be better.

---

Logic

As far as I can tell you make a dictionary of all values with an interior color. Then you make a dictionary of all values `in the same range as the first dictionary. Then you compare the dictionaries. Since you're already looping through the range for the second dictionary, I'm not sure what kind of speed gains you're getting considering you could just loop through once.

As for finding unfilled cells - I think they are the same. The color is more accurate than colorindex. I'd still use the color property though as all the rest of my code would use color before colorindex.

Answer 2

Thanks to @Raystafarian for pointing out some repetition and poor coding practice I've revised my code to look like this

Sub highlightXIDs()
    Dim lastRow As Long: lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Dim currentCell As Range, xidMap As Object

    'Get map of products(xids)
    Set xidMap = getXidMap(ActiveSheet.Range("A2:A" & lastRow))
    For Each currentCell In ActiveSheet.Range("A2:A" & lastRow)
        'Check if cell has color
        If currentCell.Interior.ColorIndex <> xlNone Then
            'If so, set all instances of the xid to that color
            xidMap(currentCell.Value).EntireRow.Columns("A").Interior.Color = currentCell.Interior.Color
        End If
    Next
End Sub

'get a "map" of each unique xid value to the rows containing it
Function getXidMap(rng As Range) As Object
    Dim xidDic As Object: Set xidDic = CreateObject("scripting.dictionary")
    Dim cell As Range
    For Each cell In rng.Cells
        If Len(cell.Value) > 0 Then
            If xidDic.exists(cell.Value) Then
                Set xidDic(cell.Value) = Application.Union(cell, xidDic(cell.Value))
            Else
                xidDic.Add cell.Value, cell
            End If
        End If
    Next cell
    Set getXidMap = xidDic
End Function