1 Attachment(s)
VBA to Hide and Show rows based on multiple ranges provided
Hi all,
I'm a complete noob when it comes to VBA scripts, I've never used it before and I'm not a programmer at all. I found a VBA script online and I don't know enough to modify it to suit my needs.
The script has 2 functions - HideRows and ShowRows. When you run them, you are asked to specify a range. For example, I can provide the following range:
'Sheet 1'!H7:H24
It will then look at the cells at H7~H24 in Sheet 1 and hide or unhide the row(s), depending on whether the cell value is a 0 or not.
What I'm trying to do is to provide multiple ranges from multiple sheets. E.g:
'Sheet 1'!H7:H24
'Sheet 2'!D5:D19
The problem is that the VBA script seems to only allow one range at a time and I need to modify this to allow multiple ranges.
For reference, I have attached a test Excel spreadsheet for you to play around with.
HTML Code:
Sub HideRows()
Dim WorkRng As Range
Dim cell As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
xTitleId = "Hide Rows"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each cell In WorkRng.Rows
If (WorksheetFunction.CountIf(cell, "<>0") - WorksheetFunction.CountIf(cell, "") = 0) And (WorksheetFunction.CountA(cell) - WorksheetFunction.Count(cell) = 0) Then
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
HTML Code:
Sub ShowRows()
Dim rng As Range
Dim WorkRng As Range
Dim xNumber As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
xTitleId = "Show Rows"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
'xNumber = Application.InputBox("Number", xTitleId, "", Type:=1)
For Each rng In WorkRng
rng.EntireRow.Hidden = False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
