MS Excel VBA Code Will Not Expand when Rows are Grouped

[OilEconomist]

Thanks in advance for your assistance. When I run the code and the groups below those words are collapsed, why won't it expand it.

Please note that this code has been taken from a larger Macro and reduced and tested. I understand the code can be simplified for what I am doing, but I have it that way so I can relate it to the larger code it was extracted. I would like to keep that the same and just have the issue corrected.

Book4
	A	B	C	D	E	F	G
1
2
3
4			HEADING
5			Section 1
6
7
8			Section 2
9
10
11
12			Section 3
13
14
15
16
17
18
19
Sheet1

Sub Expand_Issue()



'Dimensioning
    
    Dim CF As Long, CL As Long, RH As Long, RF As Long, RL As Long
    Dim ShtNmActv As String, MacroText As String
    
    Dim aCell As Range, Rng As Range
    
    

'Code
    
    ShtNmActv = "Sheet1"
    
    
    
    
    
    With Sheets(ShtNmActv)
        
        On Error Resume Next
        CF = .Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, searchdirection:=xlNext).Column
        
        On Error Resume Next
        CL = .Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, searchdirection:=xlPrevious).Column
        
        On Error Resume Next
        RF = .Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, searchdirection:=xlNext).Row
        RH = RF
        RF = RH + 1
        
        On Error Resume Next
        RL = .Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, searchdirection:=xlPrevious).Row
        
        
        
        'Set Range
         Set Rng = .Range(.Cells(RF, CF), .Cells(RL, CF))
        
        
        'Loop for first section
         For Each aCell In Rng
            If aCell = "Section 1" Then
                If .Rows(aCell.Row + 1).Hidden = True Then
                    .Rows(aCell.Row + 1).Expand
                End If
                Exit For
            End If
         Next aCell
        
        
        'Loop for second section
         For Each aCell In Rng
            If aCell = "Section 3" Then
                If .Rows(aCell.Row + 1).Hidden = True Then
                    .Rows(aCell.Row + 1).Expand
                End If
                Exit For
            End If
         Next aCell

        
    End With
    


End Sub