Group and Hide rows

[Mcstefan]

Hi,
I have the following data per image #1. The cell A1 is a data validation list with "aaa", "bbb" and "" values available. Once one of the value in cell A1 is selected then the fallowing macro executes.
For example if I select "aaa" in cell A1 then I get the result per image #3, meaning all rows containing "aaa" in the first column are collapses by group level 3 and all the rows containing "bbb" value are hidden.
However, the desired result should have been per image #2, meaning all rows containing "aaa" in the first column should have been collapsed by group level 2 level and all the rows containing "bbb" value are hidden.

Can anyone help me get a fix to the macro?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
Application.Run "HideRows"
End If
End Sub


Sub HideRows()
Dim strText As String
strText = Range("A1").Value
StartRow = 3
EndRow = 29
ColNum = 1

ActiveSheet.Outline.ShowLevels RowLevels:=2

For i = StartRow To EndRow
If Cells(i, ColNum).Value <> strText Then
Cells(i, ColNum).EntireRow.Hidden = True
Else
Cells(i, ColNum).EntireRow.Hidden = False
End If
Next i

strText = vbNullString
End Sub

 

[shknbk2]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
        HideRows
    End If
End Sub

Sub HideRows()
    Dim strText As String
    strText = Range("A1").Value
    StartRow = 3
    EndRow = 29
    ColNum = 1
    
    ActiveSheet.Rows.Hidden = False
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    
    For i = StartRow To EndRow
        If Cells(i, ColNum).Value <> vbNullString And Cells(i, ColNum).Value <> strText Then
            Cells(i, ColNum).EntireRow.Hidden = True
            i = i + 1
            Do While Cells(i, ColNum).EntireRow.OutlineLevel > 1
                Cells(i, ColNum).EntireRow.Hidden = True
                i = i + 1
            Loop
            Cells(i, ColNum).EntireRow.Hidden = True
        End If
    Next i
End Sub

 

[Mcstefan]

Thank you very much. It worked like a charm.
Cristian.