Patrick Cushing
Patrick Cushing

Reputation: 25

Dynamically Hide/Unhide a Range of Rows Based On Changes From A Single Reference Row

Follow-up of Dynamically Hide/Unhide Multiple Ranges Using VBA With Minimal Lag, to provide further or more clear details.

I am creating a worksheet that uses formulas to auto populate what is essentially an order form based off of information chosen from a single reference row.

In the screenshot row #12 is being used to populate rows 15 to 31 with the relevant information. This is a total of 17 rows. There are two additional rows that have no formulas and are used for padding or manual entry of information.
Worksheet Sample

I want is to dynamically hide or unhide rows in the 17 row block based off of the selections in the reference row so as to eliminate possible blank lines in the middle of each block.

There are a total of 35 reference rows each with 17 cell blocks being used in the worksheet.

In my original question I was using the below method to trigger the changes on a line by line basis. Which I've since learned looks for changes in the entire worksheet and not select ranges. Good for small datasets, not so much with large ones.

Private Sub_Worksheet_Change(ByVal Target As Range)

I used the code from the accepted answer to create multiple subs updating the lastR and firstR declarations to match the row blocks that I need to have hidden or unhidden, and then calling them from within a Private Sub Worksheet_Change event.

Sub Hide1()
 Dim sh As Worksheet, lastR As Long, firstR As Long
 Dim rng As Range, rngH As Range, arr, i As Long
 
 Set sh = ActiveSheet 'use here the sheet you need
 lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row 'last row on B:B
 firstR = 15          'first row of the range to be processed
 Set rng = sh.Range("B" & firstR & ":B" & lastR)
 rng.EntireRow.Hidden = False       'show all rows in the range

 arr = rng.Value                    'place the range in an array for faster iteration
 For i = 1 To UBound(arr)
    If arr(i, 1) = "" Then
        If rngH Is Nothing Then    'set the range to keep the cells where the rows must be hidden
            Set rngH = rng.cells(i, 1)
        Else
           Set rngH = Union(rngH, rng.cells(i, 1))
        End If
    End If
 Next
 'hide the rows at once:
 If Not rngH Is Nothing Then rngH.EntireRow.Hidden = True
End Sub

This again gets slow because of the Worksheet_Change constantly checking the entire worksheet and not just the reference rows. This is my fault for not clearly explaining what I wanted the code to do.

So to break it down, I want to use the above code or something similar (because I understand it) in a Worksheet_Change event, but only when the reference rows are changed. Each of these reference rows begin with Run X (where X is the number of the shelving run within the store) in the first column, has two rows of descriptive data that need to remain unhidden beneath it, and then has 17 rows of auto populated data that require hiding/unhiding.

Upvotes: 0

Views: 709

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Please, try the next way. It assumes that all rows to be triggered by the event should have in column B:B a string pattern like "RUN " followed by 1, 2, 3 and so on. Based on that, the below solution will build an array able to be transformed in a range, the single one triggering the event:

  1. Please, copy the next adapted Sub able to receive three parameters from the event call:
Sub Hide_Global(firstR As Long, lastR As Long, sh As Worksheet)
 Dim rng As Range, rngH As Range, arr, i As Long

 Set rng = sh.Range("B" & firstR & ":B" & lastR)
 rng.EntireRow.Hidden = False       'show all rows in the range

 arr = rng.Value                    'place the range in an array for faster iteration
 For i = 1 To UBound(arr)
    If arr(i, 1) = "" Then
        If rngH Is Nothing Then     'set the range to keep the cells where the rows must be hidden
            Set rngH = rng.Cells(i, 1)
        Else
           Set rngH = Union(rngH, rng.Cells(i, 1)) 'create a Union range for all occurrences
        End If
    End If
 Next
 'hide the rows at once:
 If Not rngH Is Nothing Then rngH.EntireRow.Hidden = True
End Sub
  1. Please, copy the next event instead of the existing one:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim lastR As Long, rng As Range

   lastR = Me.Range("B" & Me.Rows.Count).End(xlUp).Row 'last row in column B:B
   'build the range to trigger the event using triggeredRng function:
   Set rng = triggeredRng(Me.Range("B1:B" & lastR))
   
   If Not Intersect(Target, rng) Is Nothing Then        'let the event running only for changes in the appropriate rows:
        Application.EnableAnimations = False: Application.ScreenUpdating = False 'some optimization
        
        Me.Calculate 'let the formulae to be updated
        'send to the rows hiding Sub  the range to be processed limits:
        Hide_Global Target.Row + 3, Target.Row + 19, Me
        
        Application.ScreenUpdating = True: Application.EnableAnimations = True
   End If
End Sub

The following function is called by the above event code, building the range to trigger it:

Function triggeredRng(rng As Range) As Range 'it returns the range able to trigger the event
 Dim i As Long, k As Long, arr, arrRows, rngAddr As String, lastR As Long
   lastR = rng.Rows.Count                       'last range row
   arr = rng.Value                              'place the range in an array, for faster iteration
   ReDim arrRows(UBound(arr))                   'reDim initially the array to be sure that there are enough place for expected elements
   For i = 12 To lastR                          'iterate between the array elements:
        If Left(arr(i, 1), 3) = "RUN" Then 'if cells with a pattern starting with "RUN" exist:
            arrRows(k) = i: k = k + 1           'place the row number as an array element and increment k
        End If
   Next i
   ReDim Preserve arrRows(k - 1)                'keep only the array not empty elements
   rngAddr = "A" & Join(arrRows, ",A")          'make a string by joining the array in this way
   Set triggeredRng = Me.Range(rngAddr).EntireRow 'build a discontinuous range using the above built string
End Function

The logic of the above (suggested) solution is the next: When a change take place in the sheet where the event exists, a range built only by rows containing "RUN x" in B:B column (where x =1, 1, 3 and so on), will condition the event to process a specific range. The existing Sub hiding the rows has been modified, in order to accept firstR and lastR parameters, according to the explained rule.

The code can be optimized by creating a list validated cell, which containing all the strings type "RUN x", to easily reach them when needed. If you think it would be necessary, I will show you how to do that.

Please, test the suggested solution and send some feedback.

Upvotes: 2

Related Questions