VBA event change to hide specific rows (dynamic amount) determined by cell value

[wbstadeli]

Hi,

Im trying to come up with code that the following sample simulates:

Within an excel table, one of the columns (B) can have different values. There is "Item" and then the rows beneath that row pertain to that specific item, until the next "Item" then it repeats this pattern (the amount of rows beneath an item is variable, not a set amount). For example one item may have 3 rows of "Time". What remains as a constant is whenever there is "Item", that item has its own set of rows pertaining to it, underneath, until the next "Item".

What I want to do in VBA is, create a worksheet change event that when I select "Hide Rows" (from a dropdown list) in cell left of "Item", it hides all rows between that ITEM (row that the "Hide Rows" event trigger is on) and the next ITEM. Then I would also like the reverse option, "Show Rows" to unhide the pertaining rows to the specific item (determined by the event trigger cell to the left of the "Item" trying to unhide row underneath.

Thank you for any help!

	A	B	C
1	Dropdown list selection here	Item
2		Costs	This row pertains to Item B1
3		Time	This row pertains to Item B1
4		Divider	This row pertains to Item B1
5		Breakouts	This row pertains to Item B1
6		Item Divider	This row pertains to Item B1
7	Dropdown list selection here	Item
8		Costs	This row pertains to Item B7
9		Time	This row pertains to Item B7
10		etc...	This row pertains to Item B7

 

[Sam_D_Ben]

How about this,

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet: Set ws = Me
    If Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub
    If LCase(Trim(Target.Offset(0, 1).Value)) <> "item" Then Exit Sub

    Dim action As String: action = LCase(Trim(Target.Value))
    Dim startRow As Long: startRow = Target.Row + 1
    Dim endRow As Long: endRow = startRow
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

    Application.EnableEvents = False
    Do While endRow <= ws.Rows.Count
        If LCase(Trim(ws.Cells(endRow, 2).Value)) = "item" Or ws.Cells(endRow, 2).Value = "" Then Exit Do
        endRow = endRow + 1
    Loop

    If endRow > startRow Then
        ws.Rows(startRow & ":" & endRow - 1).EntireRow.Hidden = (action = "hide rows")
    End If
    Application.EnableEvents = True
End Sub

Assuming this is how your data is,

 

[Fuji]

Or without loop.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s$, lr&, x&, myRow&
    If Target.Column <> 1 Then Exit Sub
    If UCase$(Target(, 2)) <> "ITEM" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    lr = [max(if(b1:b50000<>"",row(1:50000)))]
    myRow = Target.Row + 1
    s = "b1:b" & lr
    x = Evaluate(Replace("min(if((#=""Item"")*(row(#)>" & myRow & "),row(#)))", "#", s))
    If x = 0 Then x = lr + 1
    Rows(Target.Row + 1 & ":" & x - 1).Hidden = UCase$(Target.Value) = "HIDE ROWS"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Sam_D_Ben]

Or,

Private Sub Worksheet_Change(ByVal t As Range)
    If t.Column <> 1 Or UCase$(t(1, 2)) <> "ITEM" Then Exit Sub
    Dim a$, b&, c&, d&, w, f
    Set w = Me: a = UCase$(t.Value): b = t.Row + 1
    Application.EnableEvents = False: Application.ScreenUpdating = False
    Set f = w.Columns(2).Find("Item", w.Cells(b - 1, 2), , 1, 1, 1)
    c = w.UsedRange.Rows(w.UsedRange.Rows.Count).Row + 1
    d = IIf(f Is Nothing Or f.Row <= t.Row, c, f.Row)
    w.Rows(b & ":" & d - 1).Hidden = (a = "HIDE ROWS")
    Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

 

[wbstadeli]

How about this,

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet: Set ws = Me
    If Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub
    If LCase(Trim(Target.Offset(0, 1).Value)) <> "item" Then Exit Sub

    Dim action As String: action = LCase(Trim(Target.Value))
    Dim startRow As Long: startRow = Target.Row + 1
    Dim endRow As Long: endRow = startRow
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

    Application.EnableEvents = False
    Do While endRow <= ws.Rows.Count
        If LCase(Trim(ws.Cells(endRow, 2).Value)) = "item" Or ws.Cells(endRow, 2).Value = "" Then Exit Do
        endRow = endRow + 1
    Loop

    If endRow > startRow Then
        ws.Rows(startRow & ":" & endRow - 1).EntireRow.Hidden = (action = "hide rows")
    End If
    Application.EnableEvents = True
End Sub

Assuming this is how your data is,
View attachment 124206

Thank you! This code is a great starting point for me, sure appreciate your help!

 

[wbstadeli]

Or without loop.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s$, lr&, x&, myRow&
    If Target.Column <> 1 Then Exit Sub
    If UCase$(Target(, 2)) <> "ITEM" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    lr = [max(if(b1:b50000<>"",row(1:50000)))]
    myRow = Target.Row + 1
    s = "b1:b" & lr
    x = Evaluate(Replace("min(if((#=""Item"")*(row(#)>" & myRow & "),row(#)))", "#", s))
    If x = 0 Then x = lr + 1
    Rows(Target.Row + 1 & ":" & x - 1).Hidden = UCase$(Target.Value) = "HIDE ROWS"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Im using Sam_D_Ben's first reply as a starting base, but thank you for your time on this!