2
\$\begingroup\$

I'm currently using the following code that is triggered as each cell in a column is updated. It works fine, but takes a couple seconds for every cell, which is really cumbersome with ~200 cells to complete the sheet. Is there any way to speed up this code?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Sheet1.Cells.EntireRow.AutoFit
Dim iLastRow As Variant
Dim i As Integer
iLastRow = Range("R1:R" & Cells(Rows.Count, "R").End(xlUp).Row).Value
For i = 1 To UBound(iLastRow, 1)
 If Range("R" & i) = "Show" Then
 Rows(i).EntireRow.Hidden = False
 Else
 Rows(i).EntireRow.Hidden = True
 End If
Next
Application.ScreenUpdating = True
End Sub
Sᴀᴍ Onᴇᴌᴀ
29.5k16 gold badges45 silver badges201 bronze badges
asked Nov 7, 2017 at 23:00
\$\endgroup\$
2
  • \$\begingroup\$ triggered as each cell in a column is updated - which column exactly? Because right now the logic is invoked whenever any cell changes on that sheet. \$\endgroup\$ Commented Nov 8, 2017 at 0:40
  • \$\begingroup\$ Columns C and D in Sheet1. The above code actually works if any cell is altered, but I also tried with Target.Column narrowing it down and it didn't change the execution time at all. \$\endgroup\$ Commented Nov 8, 2017 at 0:43

2 Answers 2

1
\$\begingroup\$

You have indented the blocks, but not the scopes.

Private Sub DoSomething()
 '<~ here
End Sub

Might not be the case here, but in a module with multiple procedures, it's much easier to glance at the code and see where scopes begin & end when their contents are indented.


Application.ScreenUpdating = False

That's great: Excel isn't going to be wasting cycles repainting itself everytime you make a change. There's a problem though:

Application.ScreenUpdating = True

If there's a runtime error anywhere between these two instructions, execution jumps out of the procedure scope and ScreenUpdating never gets set back to True, and because the error is never handled, well, you have a potentially unhandled runtime error waiting to be thrown without warning in your user's face.

Right here:

If Range("R" & i) = "Show" Then

If Range("R" & i) contains an error value, VBA can't compare it to a String literal, and boom, runtime error 13, type mismatch. You should always assume that a worksheet cell can contain an error (#VALUE!, #NA, #REF!, etc.), and shield your code against that classic mistake using the IsError function:

If Not IsError(Range("R" & i)) Then

In any case, whenever you toggle Application state, the procedure should have an On Error statement that ensures state is cleanly toggled back in case of an error.

Private Sub DoSomething()
 On Error GoTo CleanFail
 Application.ScreenUpdating = False
 '...do stuff...
CleanExit:
 Application.ScreenUpdating = True
 Exit Sub
CleanFail:
 '...handle error...
 Resume CleanExit
End Sub

Dim iLastRow As Variant

This means to be a row number, and given the Systems Hungarian prefix (drop it!), it has all looks of an Integer. It should be a Long, because a 16-bit signed integer couldn't work with more than 32,767 rows - and a worksheet can have many, many more rows than that. Internally, the VBA7 runtime allocates a 32-bit integer for it anyway, so you might as well use a Long.

Except you can't.

iLastRow = Range("R1:R" & Cells(Rows.Count, "R").End(xlUp).Row).Value

Because it's actually an array, that contains every single value in column R!

That's actually not a bad idea in itself, except the only thing you're using it for, is to determine how many "cells" it contains - here:

For i = 1 To UBound(iLastRow, 1)

Write code that says what it means, and means what it says. If you name a variable "last row", make it hold the last row number - not a variant array that contains every single value in a column. Or, name it visibilityToggleColumn or something similar.

i being an Integer is also problematic. Use a Long, so you don't need to worry about how many rows there might be - there's no reason to use an Integer for this.


This Boolean assignment is a common pattern:

If Range("R" & i) = "Show" Then
 Rows(i).EntireRow.Hidden = False
Else
 Rows(i).EntireRow.Hidden = True
End If

So common, the latest 2.1 pre-release of Rubberduck includes an inspection (and a quick-fix) for it:

Boolean literal assignment in conditional

A member is assigned True/False in different branches of an If statement with no other statements in the conditional. Use the condition directly to assign the member instead.

Applying the quickfix turns this:

 If Range("R" & i) = "Show" Then
 Rows(i).EntireRow.Hidden = False
 Else
 Rows(i).EntireRow.Hidden = True
 End If

Into this:

 Rows(i).EntireRow.Hidden = Not (Range("R" & i) = "Show")

Which can then be simplified to this:

 Rows(i).EntireRow.Hidden = Range("R" & i) <> "Show"

Rubberduck also complains about implicit references to ActiveSheet - these are the root cause behind roughly 40%1 of all VBA questions asked on Stack Overflow, every day.

Unqualified Range, Rows, Columns, Names, and Cells calls, all implicitly refer to the ActiveSheet... when you're in a standard module. When you're in a worksheet module's code-behind, they implicitly refer to that sheet. The simple fact that the same identical code does different things depending on where it's written, should be enough to be explicit about it.

Since this is all happening behind Sheet1, IMO the ideal qualifier would be Me. So instead of this:

Sheet1.Cells.EntireRow.AutoFit

I would have that:

Me.Cells.EntireRow.AutoFit

And then here:

iLastRow = Range("R1:R" & Cells(Rows.Count, "R").End(xlUp).Row).Value

I'd have this:

iLastRow = Me.Range("R1:R" & Me.Cells(Me.Rows.Count, "R").End(xlUp).Row).Value

Note that if you're in the code-behind for Sheet1, you can interchangeably use Sheet1 and Me, ...but you shouldn't. Consistency is king. Seeing Me as a qualifier immediately reminds the reader that they're looking at code that's in a class module (a Worksheet is a class, Sheet1 is a Worksheet instance; ditto for Workbook and ThisWorkbook). On the other hand, qualifying with a specific worksheet's codename makes that code usable from anywhere, i.e. if you want to move that code from Sheet1.Worksheet_Change to the ThisWorkbook.SheetChange handler, nothing would have to change and it would work identically.


Okay got it. Now what about performance?

Worksheet manipulations are inherently slow. Reading & writing cell values is slow, and resizing and formatting cells is even slower.

Surely you know of the "hold Ctrl down" trick? Hold down the Ctrl key, click on the row headings you want to hide, right-click once, pick "hide" once, and poof all the selected rows get hidden at once!

You can do exactly the same thing in VBA, using a little Union helper function - something like this:

Private Function CombineRanges(ByVal source As Range, ByVal toCombine As Range) As Range
 If source Is Nothing Then
 Set CombineRanges = toCombine
 Else
 Set CombineRanges = Union(source, toCombine)
 End If
End Function

Now all you'll be doing with Range objects, is dereferencing them - as opposed to accessing their members and mutating their state.

Before I share the resulting code, I'd like to add that there are probably certain things you want to abstract away into other members. I'd declare module-level Const values, to avoid magic literals, and I'd probably expose a Property Get members or two, to abstract as many concepts and expose them to other code if they need to - otherwise make them Private, doesn't hurt.

So anyway, here's my version:

Option Explicit
Private Const VisibilityToggleColumn As Long = 18 'column "R"
Private Const VisibilityToggleValue As String = "Show"
Public Property Get LastRow() As Long
 LastRow = Me.Cells(Me.Rows.Count, VisibilityToggleColumn).End(xlUp).Row
End Property
Public Property Get VisibilityToggleColumnValues() As Variant
 VisibilityToggleColumnValues = Me.Range(Me.Cells(1, VisibilityToggleColumn), Me.Cells(LastRow, VisibilityToggleColumn)).Value
End Property
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo CleanFail
 ToggleApplicationState False
 Me.Cells.EntireRow.AutoFit
 Dim rowsToHide As Range
 Dim rowsToShow As Range
 Dim visibilityToggleValues As Variant
 visibilityToggleValues = VisibilityToggleColumnValues
 Dim i As Long
 For i = LBound(visibilityToggleValues) To UBound(visibilityToggleValues)
 Dim currentCell As Range
 Set currentCell = Me.Cells(i, VisibilityToggleColumn)
 Dim currentToggle As Variant
 currentToggle = visibilityToggleValues(i, 1)
 If IsError(currentToggle) Then
 'if a cell contains an error, we don't want to hide it
 Set rowsToShow = CombineRanges(rowsToShow, currentCell)
 Else
 If StrComp(currentToggle, VisibilityToggleValue, vbTextCompare) = 0 Then
 Set rowsToShow = CombineRanges(rowsToShow, currentCell)
 Else
 Set rowsToHide = CombineRanges(rowsToHide, currentCell)
 End If
 End If
 Next
 If Not rowsToShow Is Nothing Then rowsToShow.EntireRow.Hidden = False
 If Not rowsToHide Is Nothing Then rowsToHide.EntireRow.Hidden = True
CleanExit:
 ToggleApplicationState True
 Exit Sub
CleanFail:
 MsgBox "Unhandled error in 'Worksheet_Change' handler: " & Err.Description, vbExclamation
 Resume CleanExit
 Resume
End Sub
Private Sub ToggleApplicationState(ByVal enabled As Boolean)
 Application.ScreenUpdating = enabled
 Application.EnableEvents = enabled
 Application.Calculation = IIf(enabled, xlCalculationAutomatic, xlCalculationManual)
End Sub
Private Function CombineRanges(ByVal source As Range, ByVal toCombine As Range) As Range
 If source Is Nothing Then
 Set CombineRanges = toCombine
 Else
 Set CombineRanges = Union(source, toCombine)
 End If
End Function

Notice I'm using the StrComp function to compare the strings with vbTextCompare - this ensures a case-insensitive comparison without the extra processing overhead of LCase/LCase$ or UCase/UCase$ conversions.

That code runs in just over 200ms2, with over 13,000 rows in column R - and there's probably still more room for improvements, but I'll leave it at that for now.


1By no scientific measurement whatsoever. It's just an extremely common mistake.

2Lazily measured with a very basic Timer diff.

answered Nov 8, 2017 at 3:14
\$\endgroup\$
1
  • 2
    \$\begingroup\$ Matt, this is amazing. The performance issue is completely fixed. As always, your conceptual responses are so helpful; I think I owe a lot of my (albeit limited) coding knowledge to your responses between here and Stack Overflow. Thank you! \$\endgroup\$ Commented Nov 8, 2017 at 16:53
1
\$\begingroup\$

Reading from the spreadsheet is slow. Best to work with a variant array. I didn't have any speed issues with either using. I don't see much else to speed it up. Used LCase$ to guard against typos.

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.ScreenUpdating = False
 Dim start As Single
 start = Timer
 With Sheet1 'Explicitly qualifies everything that starts with '.' (Period)
 .Cells.EntireRow.AutoFit
 Dim lastRow As Long
 lastRow = .Cells(Rows.Count, "R").End(xlUp).Row
 Dim showHideCriteria As Variant
 showHideCriteria = .Range("R1:R" & lastRow).Value
 Dim i As Integer
 For i = 1 To UBound(showHideCriteria) ' Redundant 1 parameter
 If LCase$(showHideCriteria(i, 1)) = "show" Then ' Empty cells treated as vbNullString
 'If LCase$(Range("R" & i)) = "show" Then 'Uncomment this line and comment line above to compare speed.
 .Rows(i).EntireRow.Hidden = False
 Else
 .Rows(i).EntireRow.Hidden = True
 End If
 Next
 End With
 Debug.Print "Took " & Timer - start & " seconds"
 Application.ScreenUpdating = True
End Sub
answered Nov 8, 2017 at 0:01
\$\endgroup\$
4
  • \$\begingroup\$ Thanks so much for this! It is still taking quite a while. The timer you coded for says 2.5-3.5 seconds per cell modification. Is that what you were getting? \$\endgroup\$ Commented Nov 8, 2017 at 0:06
  • \$\begingroup\$ I loaded up a blank spreadsheet. I was getting fractions of a second when I tested it. I've a feeling that how you have your sheet set up will matter more than any performance gains you could get from maximizing this code. Post your code, assuming it doesn't contain sensitive info, and get reviews for the rest of your code. Note: Critiques to code aren't against the coder, they are to make the code better & more robust. Welcome to CodeReview! \$\endgroup\$ Commented Nov 8, 2017 at 0:25
  • \$\begingroup\$ For sure, I'm really new to coding, so I really appreciate the constructive criticism. Is it possible here to upload a file? That is actually all of the code for this sheet right now. I was given the book to add code for that one process, but the rest of the sheet has some pretty complicated formula work, which I unfortunately don't know enough about to critique or edit. Could that be what is slowing it down? \$\endgroup\$ Commented Nov 8, 2017 at 0:41
  • \$\begingroup\$ Calculation mode being set to automatic could indeed make your code slower. I have an answer brewing FWIW. \$\endgroup\$ Commented Nov 8, 2017 at 0:54

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.