Most efficient way to highlight cells using VBA

[Huhenyo]

Hello everyone. I've got some very large sets of data that I have a VBA program highlighting, but it can take upwards of 25 minutes to complete on some data sets. I'm wondering if there is maybe a more efficient way to do this to help cut down the time it takes to process. Here is just a little piece of the code demonstrating the way I'm doing the highlighting. Your expertise is much appreciated. I love this forum!

For Each Cell In rngLookForNames
        strContents = Trim(Cell.Value)
        If strContents Like "?*)" And Not strContents Like "Patient(Chart*" Then ' starts with a letter and ends with ) but isn't "Patient(Chart#)
            lngRowNum = Cell.Row
            intTotalCount = intTotalCount + 1
            intAtLeastOneUpper = 0
            For k = 3 To lngNumberOfColumns
                If intUpperLimit <> 0 Then ' this indicates the person wanted an upperlimit
                    If Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Value >= intThreshold And Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Value < intUpperLimit Then
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .ThemeColor = xlThemeColorLight2
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Font
                            .ThemeColor = xlThemeColorDark1
                            .TintAndShade = 0
                        End With
                    End If                    If Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Value >= intUpperLimit Then
                        intAtLeastOneUpper = intAtLeastOneUpper + 1 ' if this is >0 then there was a value for the patient we are on that was > UpperLimit
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Borders(xlEdgeLeft)
                            .LineStyle = xlContinuous
                            .Color = 597641
                            .TintAndShade = 0
                            .Weight = xlThick
                        End With
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Borders(xlEdgeTop)
                            .LineStyle = xlContinuous
                            .Color = 597641
                            .TintAndShade = 0
                            .Weight = xlThick
                        End With
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Color = 597641
                            .TintAndShade = 0
                            .Weight = xlThick
                        End With
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Borders(xlEdgeRight)
                            .LineStyle = xlContinuous
                            .Color = 597641
                            .TintAndShade = 0
                            .Weight = xlThick
                        End With
                    End If
                Else ' if the person didn't want an uppper limit, just highlight everything above threshold
                    If Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Value >= intThreshold Then
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .ThemeColor = xlThemeColorLight2
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                        With Range(Cells(lngRowNum, k), Cells(lngRowNum, k)).Font
                            .ThemeColor = xlThemeColorDark1
                            .TintAndShade = 0
                        End With
                    End If
                End If
            Next
            If intAtLeastOneUpper > 0 Then
                intUpperCount = intUpperCount + 1 ' If there was at least one day > upperlimit, count that patient as one above upper limit
                 put a Red box around the person's name indicating that they are above the upper limit
                With Range(Cells(lngRowNum, 1), Cells(lngRowNum, 2)).Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Color = 597641
                    .TintAndShade = 0
                    .Weight = xlThick
                End With
                With Range(Cells(lngRowNum, 1), Cells(lngRowNum, 2)).Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Color = 597641
                    .TintAndShade = 0
                    .Weight = xlThick
                End With
                With Range(Cells(lngRowNum, 1), Cells(lngRowNum, 2)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Color = 597641
                    .TintAndShade = 0
                    .Weight = xlThick
                End With
                With Range(Cells(lngRowNum, 1), Cells(lngRowNum, 2)).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Color = 597641
                    .TintAndShade = 0
                    .Weight = xlThick
                End With
            End If
        End If
        percentDone = Round(ticker / lngNumberOfRows, 2)
        If percentDone <> oldPercentDone Then
            frmCalculationsProgress3.CalculationsProgress (percentDone)
            oldPercentDone = percentDone
        End If
        ticker = ticker + 1
    Next Cell

 

[Fazza]

hi,

assuming you have screen updating off, enableevents false, calculation off, etc biggest help is addressing looping through cells to work with values. that is slow. lots of reading from the worksheet. instead, load the values to an array & loop through the array

so something like, say for a range "A1:Z10000"
ar = rangereference.value
for i = lbound(ar,1) to ubound(ar,1)
for j = lbound(ar,1) to ubound(ar,2)
debug.print i,j,ar(i,j)
next j
next i

also consider things like
to change cell colour, can you use one liner like range.interior.colorindex = 38
or a borderaround one liner instead of putting each border edge individually

and the percent done, only update every 100 loops, or 1000, whatever.

hth

 

[Huhenyo]

Fazza, thank you for your help. I actually do most of my stuff in arrays, but in the case of highlighting the cells, I don't think there is a way to do it but by looping through the actual sheet. Am I wrong? I'll see if I can do the all 4 sides at the same time idea you have. That will probably be better. Not sure why I didn't think about that, but not sure it can be done either. The updating of the loops I had to do that often because on big data sets, it would set there without any feedback to the user for quite some time and I worry that the user will think it is a problem although I'm going to try it and see if it will move often enough on big data sets to not be a problem.

I'll post back what I figure out so it can be of help to others.

Thanks again,
-Nick

 

[Huhenyo]

I played around a bit with this and it appears that changing the number of percentage updates doesn't affect the time much. I think the bottleneck is the boarders. Does anyone know a way to change the color of the boards all at the same time rather than each edge individually?

 

[mikerickson]

You could use Styles to set border colors.

 

[Huhenyo]

would that make it so I wouldn't have to set each boarder separately or would it just change the way the color is assigned?

 

[Huhenyo]

Additionally, I changed the code to highlight the cell rather than put a board around it (had to change the font color to do that) and it cut the time in half on large sets which significantly better. I'll have to experiment with Styles. Thanks for the tips!

 

[Fazza]

borderaround method of range object

https://msdn.microsoft.com/en-us/library/office/ff197210.aspx

 

[Fazza]

... in the case of highlighting the cells, I don't think there is a way to do it but by looping through the actual sheet.

Hi, Nick

Yes to highlighting the cells, But all the reading of cell values is slow. So, read them at the beginning of the code and then loop through the array working with the values to identify what needs to be formatted. the formatting to the worksheet would be done in multiple steps but the getting the values & doing all the if some value < some other would not involve lots of reading from the worksheet.

Another thought. You could create a (text) string of the cell address to be highlighted and do a whole lot en masse. Such as 100 cells different cells all with the same format in one operation.
Same thing another way would be to UNION the ranges into a single range object to apply, for example, 100 formats at once to that (UNION'd) range. This is probably easier & faster than you'd expect.

cheers

 

[Huhenyo]

Ok, I see what you are saying now. I will try that out. Thank you for your help. The idea of creating a test string and highlighting all at the same time is quite intriguing. I'm going to see if I can figure that out. I'm sure that would be a lot faster. Thanks for your thoughts!!