This is similar to another answer but testing shows performance is nearly 1.5 orders of magnitude (70x) faster by doing all the property changes in two transactions; one each for hideRange.EntireRow.Hidden = True
and unhideRange.EntireRow.Hidden = False
.
There are three constants at the beginning of the file used to specify the column, starting row, ending row and value to hide on. The OP values have been plugged in.
Copy the following code into the specific vba WorkSheet module. This code will not work from a regular module. Press Alt-F11 to open the Visual Basic Editor. Press Ctrl-R to focus/open the Project Explorer pane. Navigate to VBAProject(<file name>)
, Microsoft Excel Objects
and open the Sheet#(<sheet name>)
where the hidden rows reside.
Private Sub Worksheet_Calculate()
' Hide Rows if row value in watch_Column is hide_On_Value.
' watch_Column must include start_on row number (e.g. A1 or C3)
' Hidden rows, beyond the range of cells with values, may not
' unhide. For speed, only process rows being used <= end_of_watch.
Const watchColumn = "B45" ' Beginning Cell (row and column) to watch.
Const endOfWatch = "135" ' Last row. if "", rest of rows in use.
Const hideOnValue = 0
Dim hideRange As Range
Dim unhideRange As Range
Dim r As Range
Dim seeRow As Boolean
Dim watchStart() As String
Dim lastRow As String
Dim tmpEnableEvents As Boolean
Set r = Me.UsedRange ' call and discard to reset LastCell
With Me.UsedRange
lastRow = .Row + .Rows.Count - 1
End With
If endOfWatch <> "" Then
If Val(lastRow) > Val(endOfWatch) Then lastRow = endOfWatch
End If
watchStart = Split(Me.Range(watchColumn).Address(True, False), "$")
If Val(watchStart(1)) > Val(lastRow) Then Exit Sub
tmpEnableEvents = Application.EnableEvents
Application.EnableEvents = False
For Each r In Me.Range(watchColumn & ":" & watchStart(0) & lastRow)
seeRow = True
If IsEmpty(r) Then
ElseIf CStr(r.Value2) = vbNullString Then
ElseIf r = hideOnValue Then
seeRow = False
If Not r.EntireRow.Hidden Then
If hideRange Is Nothing Then
Set hideRange = r
Else
Set hideRange = Union(hideRange, r)
End If
End If
End If
If seeRow And r.EntireRow.Hidden Then
If unhideRange Is Nothing Then
Set unhideRange = r
Else
Set unhideRange = Union(unhideRange, r)
End If
End If
Next r
If Not unhideRange Is Nothing Then
unhideRange.EntireRow.Hidden = False
End If
If Not hideRange Is Nothing Then
hideRange.EntireRow.Hidden = True
End If
Application.EnableEvents = tmpEnableEvents
End Sub
Regular Module Changes
- Change the Sub name.
- Change all the
Me
objects to a specific sheet reference.
Worksheets("Worksheet Name")
criteria for one worksheet.