Consulting

Results 1 to 5 of 5

Thread: VBA to Hide and Show rows based on multiple ranges provided

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    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'!D519



    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
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •