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]

Agh, it returned Error 1004 "the sort reference is not valid" - highlighted code:

.Resize(.Rows.Count * 2).EntireRow.Resize(, 7).Sort _
                Key1:=Columns(LastColumnNumberInSheet + 1), Order1:=xlAscending, Header:=xlNo

 

[Peter_SSs]

A few comments on Post #27 code

• The idea of colouring the empty rows before sorting is a good one and saves quite a bit of time.
• The code errors. The code is sorting 7 columns of data, with column 8 (at least) trying to be used as the key in the sort.
• If there are more than 7 columns of data originally and you use the 'next' column as the sort key then you will be inserting a blank row into all columns, not as stated
  

  I need to insert a blank, shaded row between every row up to and including Col G

  (My take, given the acceptance of an earlier code, is that there are only 7 columns so no need to use time to calculate that anyway.)
• This code is wasting time as it does nothing other than put values in a range and immediately take them out again.

With .Resize(.Rows.Count * 2)
    .Value = Evaluate("1/mod(row(" & .Address & "),2)")
    .ClearContents                                                                                      ' Clear Helper Column
End With

The upshot is that this worked for me and was faster again by about 15%-20%

Sub Insert_Rows_v2()
  Dim rws As Long
 
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
  End With
  With Range("H2:H" & Range("A" & Rows.Count).End(xlUp).Row)
      rws = .Rows.Count
      .Value = Evaluate("row(" & .Address & ")")
      .Offset(rws).Value = .Value
      .Offset(rws).EntireRow.Resize(, 7).Interior.Color = RGB(229, 222, 207)
      .Resize(rws * 2).EntireRow.Resize(, 8).Sort Key1:=Columns(8), Order1:=xlAscending, Header:=xlNo
      .Resize(rws * 2).ClearContents
  End With
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
  End With
End Sub

 

[Ironman]

Thanks a lot Peter.

As an aside, I've found an unanticipated glitch - some of the entries in the cells had a validation input text box (I click those cells and get additional info) and they're now out of synch i.e. the validation boxes don't relate to the correct rows. I thought they were assigned to the existing entries but it seems not

 

[johnnyL]

I have had a lot of fun playing with this code for this thread.

I think my latest version equates basically to the same time elapsed as @Peter_SSs latest version.
The only difference I can see is that I don't hard code the helper column to the 'H' column. The code I use looks for the last used column in the sheet and then uses the next column for the helper column. This prevents 'stepping' on previous data in the sheet.

I'm glad we could help you @Ironman. It is especially fun when we can 'bicker' back and forth over tenths of a second improvements in coding.

My latest, and most likely my last version, of code for this thread:

Sub InsertBlankShadedRowsV6()
'
    Dim startTime   As Single
    startTime = Timer                                                                                           ' Start the stopwatch
'
    Dim LastColumnNumberInSheet As Long
    Dim LastRowInSheet          As Long
'
    Application.ScreenUpdating = False                                                                          ' Turn ScreenUpdating off
       Application.Calculation = xlCalculationManual                                                            ' Turn Calculation off
      Application.EnableEvents = False                                                                          ' Turn EnableEvents off
'
    LastColumnNumberInSheet = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column                   ' Returns a Column Number
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                                  ' Save LastRowInSheet
'
    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
        .Offset(.Rows.Count).EntireRow.Resize(, 7).Interior.Color = RGB(229, 222, 207)                          '   Shade the blank rows
        .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
        .Resize(.Rows.Count * 2).ClearContents                                                                  '   Clear Helper Column
    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

Not sure about your last Q about validation boxes @Ironman. Perhaps a new thread?

 

[Ironman]

Thanks ever so much for all your time Johnny and I'm glad you've enjoyed helping me out with my exercise log. The last Q is a real headache though!

 

[johnnyL]

Sounds like a new thread is warranted then. If you decide to post new thread please provide as much info/samples as you can. It is always easier to test against sample code that you provide, as opposed to guessing what your data may be.

 

[Peter_SSs]

This prevents 'stepping' on previous data in the sheet.

Quite true, but would insert blank rows in that extra data as I pointed out earlier. That may or may be required.
Easiest way to settle it would be for @Ironman to clarify whether there is, or could be, data beyond column G and, if so ..
- whether blank rows should be inserted in that data too and
- whether the colour should be extended into those extra columns too.