Insert alternate blank rows filled a certain colour from A3:G6211

[Ironman]

Hi

I have a sheet containing data from A2 to G6210.

I need to insert a blank, shaded row between every row up to and including Col G (all of which contain data, which must not be amended).

Specifically, I would be very grateful for a module that I can run that will insert blank rows every other row, starting A3:A6211 inclusive, with the cells filled #EEE7D7 up to and including Col G.

i.e.

A3:G3 filled #EEE7D7

A5:G5 filled #EEE7D7

A7:G7 filled #EEE7D7

etc. etc.

A6211:G6211 filled #EEE7D7

Many thanks!

 

[Ironman]

@Peter_SSs Wow, I was expecting to come back in 20 mins but it ran in less than a second - thank you!
@johnnyL thanks again - I got Compile Error "Variable [LastColumnNumberInSheet] not defined"

 

[Peter_SSs]

@Peter_SSs Wow, I was expecting to come back in 20 mins but it ran in less than a second - thank you!

You're welcome. Thanks for the confirmation.

 

[johnnyL]

@johnnyL thanks again - I got Compile Error "Variable [LastColumnNumberInSheet] not defined"

Delete the 'option explicit' at the top of your code or add a Dim LastColumnNumberInSheet

Edit: Actually that was my goof. The Dim is already there, I just forgot the 'Number' part in it. Change 'Dim LastColumnInSheet' to 'Dim LastColumnNumberInSheet'

 

[Ironman]

Thanks Johnny - "Time to complete = 0.71875 seconds."
But for some reason, the inserted cells are all shaded white i.e. RGB (255 255 255).

 

[johnnyL]

Sub InsertBlankShadedRowsV4()
'
    Dim startTime               As Single
    startTime = Timer                                                                                           ' Start the stopwatch
'
    Dim LastRowInSheet          As Long
    Dim LastColumnNumberInSheet As Long
'
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                                  ' Save LastRowInSheet
    LastColumnNumberInSheet = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column                   ' Returns a Column Number
'
    Application.ScreenUpdating = False                                                                          ' Turn ScreenUpdating off
       Application.Calculation = xlCalculationManual                                                            ' Turn Calculation off
      Application.EnableEvents = False                                                                          ' Turn EnableEvents off
'
    With Range(Cells(2, LastColumnNumberInSheet + 1), Cells(LastRowInSheet, LastColumnNumberInSheet + 1))       ' Create Helper column
        .Value = Evaluate("row(" & .Address & ")")                                                              ' Load Helper values
        .Offset(.Rows.Count).Value = .Value                                                                     ' Load help values to blank rows beneath data
        .Resize(.Rows.Count * 2).EntireRow.Resize(, LastColumnNumberInSheet + 1).Sort _
                Key1:=Columns(LastColumnNumberInSheet + 1), Order1:=xlAscending, Header:=xlNo                   ' Insert Blank rows via sort of helper col
'
        With .Resize(.Rows.Count * 2)
            .Value = Evaluate("1/mod(row(" & .Address & "),2)")
            .ClearContents                                                                                      ' Clear Helper Column
        End With
    End With
'
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                                  ' Save LastRowInSheet
'
    For i = 2 To LastRowInSheet Step 2                                                                          ' Loop through blank rows
        Range("A" & i).Resize(1, 7).Offset(1, 0).Interior.Color = RGB(229, 222, 207)                            '   Shade Blank row
    Next                                                                                                        ' Loop back
'
      Application.EnableEvents = True                                                                           ' Turn EnableEvents back on
       Application.Calculation = xlCalculationAutomatic                                                         ' Turn Calculation back on
    Application.ScreenUpdating = True                                                                           ' Turn ScreenUpdating back on
'
    Debug.Print "Time to complete = " & Timer - startTime & " seconds."                                         ' Display Total run time (Ctrl-G)
'
MsgBox "Completed!"                                                                                             ' Let user know that the process is complete
End Sub

 

[Ironman]

That worked a treat Johnny, thanks ever so much!

 

[johnnyL]

The following is even faster:

Sub InsertBlankShadedRowsV5()
'
    Dim startTime               As Single
    startTime = Timer                                                                                           ' Start the stopwatch
'
    Dim LastRowInSheet          As Long
    Dim LastColumnNumberInSheet As Long
'
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                                  ' Save LastRowInSheet
    LastColumnNumberInSheet = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column                   ' Returns a Column Number
'
    Application.ScreenUpdating = False                                                                          ' Turn ScreenUpdating off
       Application.Calculation = xlCalculationManual                                                            ' Turn Calculation off
      Application.EnableEvents = False                                                                          ' Turn EnableEvents off
'
    With Range(Cells(2, LastColumnNumberInSheet + 1), Cells(LastRowInSheet, LastColumnNumberInSheet + 1))       ' Create Helper column
        .Value = Evaluate("row(" & .Address & ")")                                                              ' Load Helper values
        .Offset(.Rows.Count).Value = .Value                                                                     ' Load help values to blank rows beneath data
        Range("A" & LastRowInSheet + 1 & ":G" & Cells.Find("*", , xlFormulas, , xlByRows, _
                xlPrevious).Row).Interior.Color = RGB(229, 222, 207)                                            ' Shade the blank rows
        .Resize(.Rows.Count * 2).EntireRow.Resize(, 7).Sort _
                Key1:=Columns(LastColumnNumberInSheet + 1), Order1:=xlAscending, Header:=xlNo                   ' Insert Blank rows via sort of helper col
'
        With .Resize(.Rows.Count * 2)
            .Value = Evaluate("1/mod(row(" & .Address & "),2)")
            .ClearContents                                                                                      ' Clear Helper Column
        End With
    End With
'
      Application.EnableEvents = True                                                                           ' Turn EnableEvents back on
       Application.Calculation = xlCalculationAutomatic                                                         ' Turn Calculation back on
    Application.ScreenUpdating = True                                                                           ' Turn ScreenUpdating back on
'
    Debug.Print "Time to complete = " & Timer - startTime & " seconds."                                         ' Display Total run time (Ctrl-G)
'
MsgBox "Completed!"                                                                                             ' Let user know that the process is complete
End Sub

I eliminated the loop that was slowing it down. Should be nearly instant timing. Let me know what your timing is please.

 

[Ironman]

LOL thanks a lot Johnny! I know I had a moan about it taking 20 mins but I really can't complain about 0.7 seconds

 

[johnnyL]

.7 seconds is old technology.

 

[Ironman]

I'll test it on a backup workbook to make you happy