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:
before
After:
after
- Is this an efficient use of the included vba objects or should I change something?
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?
2 Answers 2
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
.
-
\$\begingroup\$ The function shown is used earlier in my code and that is used as a reference for more efficient manipulation (pertaining strictly to a product-to-product basis). It was created by someone on SO for me and I left the variables as they had them. I know that's no excuse, I should've renamed them and cleaned up a bit, so I fully accept that blame. Also, as far as commenting my code, I'm usually quite strict about that, but as I said in my post I whipped this up in a few minutes in my downtime at work at the time. You are right, I should've name my variables more clearly. \$\endgroup\$CaffeinatedMike– CaffeinatedMike2016年03月25日 15:19:57 +00:00Commented Mar 25, 2016 at 15:19
-
\$\begingroup\$
prods
is in fact a dictionary of product keys that contain a colorfill. I store the cell value and the color of the cell to fill it after the fact. I probably should've combined those two loops somehow, but how would you suggest I do so?prod
was meant to be one item in theprods
dictionary, so I can reference each element in the dictionary as I loop. The function variable(rng as Range)
is passed byByRef
because there are times rows are added/deleted, so it'll keep the actually cell location as my code executes. But, again, I should've explained that a bit better, my apologies. \$\endgroup\$CaffeinatedMike– CaffeinatedMike2016年03月25日 15:25:16 +00:00Commented Mar 25, 2016 at 15:25 -
\$\begingroup\$ Lastly, I figured
color
is more thancolorindex
and I only usecolor
throughout my code, so I guess that answers that question, thanks! \$\endgroup\$CaffeinatedMike– CaffeinatedMike2016年03月25日 15:26:19 +00:00Commented Mar 25, 2016 at 15:26
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
-
\$\begingroup\$ If you want your revised code reviewed, you should post it as a follow up question \$\endgroup\$Kaz– Kaz2016年04月06日 13:19:01 +00:00Commented Apr 6, 2016 at 13:19
-
\$\begingroup\$ @Kaz I'm not looking for follow-up, I was simply posting adjusted code to show what came to fruition thanks to the help of the other users. \$\endgroup\$CaffeinatedMike– CaffeinatedMike2016年04月06日 13:24:20 +00:00Commented Apr 6, 2016 at 13:24
-
\$\begingroup\$ Out of interest, why not? Learning is an iterative process after all. \$\endgroup\$Kaz– Kaz2016年04月06日 13:25:27 +00:00Commented Apr 6, 2016 at 13:25
-
\$\begingroup\$ Under normal circumstances I would, but at the moment I have far too much workload (and other pieces of my code) I need to focus on building as our company's import system is changing by the end of April. \$\endgroup\$CaffeinatedMike– CaffeinatedMike2016年04月06日 13:27:07 +00:00Commented Apr 6, 2016 at 13:27