Swap and copy trick

[HURTMYPONY]

About 6 months ago, someone here gave me a solution to a macro I was building.

I needed a macro that:

1. Duplicated every row that had a value in H and added to bottom of sheet at first empty row.
2. On those duplicated rows, it swapped the values in Column A and B with the values in Column H and I.

It works beautifully:

Dim valA
Dim valB
Dim cel As Range
Dim rng As Range
Dim lastrow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Get first blank row
    lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
    
    'Build all of Col H
    Set rng = Range("H2:H" & lastrow - 1)
        
    'Check all of Col H for values
    For Each cel In rng
        'If has value
        If cel <> "" Then
            'Copy to blank row at end
            Range("A" & cel.Row & ":L" & cel.Row).Copy Range("A" & lastrow)
            'Save Col A value
            valA = Range("A" & lastrow)
            'Save Col B value
            valB = Range("B" & lastrow)
            'Copy HI to AB
            Range("H" & lastrow & ":I" & lastrow).Copy Range("A" & lastrow)
            'Put old A to H
            Range("H" & lastrow) = valA
            'Put old B to I
            Range("I" & lastrow) = valB
            lastrow = lastrow + 1
        End If
    Next cel
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    
    Set cel = Nothing
    Set rng = Nothing
    
End Sub

I am now trying to modify this code for another sheet, but differences in the layout of the sheet, coupled with my ignorance with how this code actually works, is causing me problems.

I need it to do the same thing that it does on the original, but:

1. The header starts on Row 4, not on Row 1 like on the original.
2. Instead of swapping the values in H and I with A and B on the duplicated rows, I need it to simply swap G with F.
3. My new sheet goes out to Column AQ.

Can anyone help me modify this code to work? Or even better, explain WHY it works?

Thank you!

 

[HURTMYPONY]

This blind modification I made correctly duplicates the rows, and swaps F and G on those duplicated rows, but it is now putting spaces in my data. Any advice?

Dim valA
Dim valB
Dim cel As Range
Dim rng As Range
Dim lastrow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Get first blank row
    lastrow = Range("A" & Rows.Count).End(xlUp).Row + 2
    
    'Build all of Col H
    Set rng = Range("G5:G" & lastrow - 1)
        
    'Check all of Col H for values
    For Each cel In rng
        'If has value
        If cel <> "" Then
            'Copy to blank row at end
            Range("A" & cel.Row & ":AQ" & cel.Row).Copy Range("A" & lastrow)
            'Save Col F value
            valA = Range("F" & lastrow)
            'Save Col G value
            valB = Range("G" & lastrow)
            'Copy G to F
            Range("G" & lastrow).Copy Range("F" & lastrow)
            'Put old F to G
            Range("G" & lastrow) = valA
            lastrow = lastrow + 1
        End If
    Next cel
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    
    Set cel = Nothing
    Set rng = Nothing

Disregard the remarks in the code - I didn't correct them.

 

[HURTMYPONY]

This now works, but still triples the header when there is no data to consider. Since, on some of the sheets, there may be a legitimate reason for no data, this needs to be fixed by me.

Any advice on how to modify this to not execute if there is no data beyond Row 4?

Sub Macro6()
'
' Macro6 Macro
'
Dim valA
Dim valB
Dim cel As Range
Dim rng As Range
Dim lastrow As Long

    With Application
        .ScreenUpdating = True
        .EnableEvents = False
    End With

    'Get first blank row
    lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
    
    'Build all of Col g
    Set rng = Range("G5:G" & lastrow - 1)
        
    'Check all of Col g for values
    For Each cel In rng
        'If has value
        If cel <> "" Then
            'Copy to blank row at end
            Range("A" & cel.Row & ":AQ" & cel.Row).Copy Range("A" & lastrow)
            'Save Col F value
            valA = Range("F" & lastrow)
            'Save Col G value
            valB = Range("G" & lastrow)
            'Copy G to F
            Range("G" & lastrow).Copy Range("F" & lastrow)
            'Put old F to G
            Range("G" & lastrow) = valA
            lastrow = lastrow + 1
        End If
    Next cel
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    
    Set cel = Nothing
    Set rng = Nothing
End Sub