Update to VBA code that hides rows based upon their values Code below. When it i

Question

Update to VBA code that hides rows based upon their values   

Code below. When it is run, any row between 465-492 will be hidden if the value in column D of that row is "OK" (and any row without "OK" will be unhidden).

I'm hoping to get some help with a small addition: in the event that "OK" is the value in column D for every row between 465-492 (so they're all hidden), then row 493 will be unhidden (and if any of the rows has something other than "OK", then 493 will be hidden).

Thank you!

Alt-F11 to open the VBA editor

Alt-IM to insert a new standard code module

In the new module, paste the following code

'==========>>

Option Explicit

'---------->>
Public Sub HideRows()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim rCell As Range
Dim hideRng As Range
Dim CalcMode As Long
Const myVal As String = "OK"
Const myRange As String = "D465:D492"

Set WB = ThisWorkbook
Set SH = WB.Sheets("ENDORSEMENTS")
Set Rng = SH.Range(myRange)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With Rng
Application.Goto Rng
.Rows.Hidden = False
For Each rCell In .Cells
With rCell
.Select
If UCase(.Value) = UCase(myVal) Then
If hideRng Is Nothing Then
Set hideRng = rCell
Else
Set hideRng = Union(rCell, hideRng)
End If
End If
End With
Next rCell
End With

If Not hideRng Is Nothing Then
hideRng.EntireRow.Hidden = True
Else
'nothing found, do nothing
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'<<==========

Explanation / Answer

Try the following revised 745^##$6code in which the changes are shown in bold type:

'==========>>
Option Explicit

'---------->>
Public Sub HideRows()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim rCell As Range
Dim hideRng As Range
Dim CalcMode As Long
Dim blHidden As Boolean
Const myVal As String = "OK"
Const myRange As String = "D465:D492"

Set WB = ThisWorkbook
Set SH = WB.Sheets("ENDORSEMENTS")
Set Rng = SH.Range(myRange)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With Rng
Application.Goto Rng
.Rows.Hidden = False
For Each rCell In .Cells
With rCell
.Select
If UCase(.Value) = UCase(myVal) Then
If hideRng Is Nothing Then
Set hideRng = rCell
Else
Set hideRng = Union(rCell, hideRng)
End If
End If
End With
Next rCell
End With

If Not hideRng Is Nothing Then
hideRng.EntireRow.Hidden = True
blHidden = hideRng.Rows.Count <> Rng.Rows.Count
Else
blHidden = True
End If
  
With SH
.Rows(493).Hidden = blHidden
End With

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'<<==========

Related Questions

Navigate

• Browse (All)
• Browse U
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.