Reputation: 25
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.
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
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:
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
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