Insert x number of rows

[BakerBaker]

Good morning, thanks in anticipation.

Column A consists of a variable number of rows containing data, with each "block" of rows being separated by a blank row. I would like to be able to insert X number of rows after each existing blank row so that each new "block" of rows totals 13. In the example below "JAN" is row 1 - row 14 - row 27 - row 40 etc

Col. A

• 1 JAN
• 2 FEB
• 3 MAR
• 4 APR
• 5 (blank) Insert 8 blank rows
• 14 JAN
• 15 FEB
• 16 MAR
• 17 APR
• 18 MAY
• 19 JUN
• 20 (blank) Insert 6 blank rows
• 27 JAN
• 28 FEB
• 29 MAR
• 30 APR
• 31 MAY
• 32 JUN
• 33 JUL
• 34 AUG
• 35 (blank) Insert 4 blank rows
• 40 JAN
• 41 FEB -etc.

 

[Joe4]

This is kind of a brute-force method of VBA (and I am sure that there are probably more efficient ways), but I think it gets the job done.
I am assuming that your data is in column A:

Sub MyInsertRows()

    Dim cell As Range
    Dim r1 As Long
    Dim r2 As Long
    Dim n As Long
   
'   Find first instance of "JAN"
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell.Value = "JAN" Then
            r1 = cell.Row
            Exit For
        End If
    Next cell
   
'   Message if cannot find "JAN"
    If r1 = 0 Then
        MsgBox "No instances of JAN found in column A", vbOKOnly, "ERROR!"
        Exit Sub
    End If
   
'   Loop through remaining rows, searching for next instance of JAN
    On Error GoTo leave_sub
    Do
'       Find row of next instance of "JAN"
        r2 = Range("A" & r1 & ":A" & Rows.Count).Find(What:="JAN", After:=Range("A" & r1), _
            LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Row
'       Determine number of rows to insert
        n = 13 - (r2 - r1)
        If n > 1 Then
'           Insert rows
            Rows(r2 - 1 & ":" & r2 + n - 3).Insert
'           Reset starting row
            r1 = r2 + n
        Else
'           Reset starting row
            r1 = r1 + 13
        End If
    Loop
    On Error GoTo 0
   
leave_sub:
    Err.Clear
    MsgBox "Macro complete!", vbOKOnly
   
End Sub

 

[rollis13]

Oh, I'm late, well anyway, here is what I came up with:

Option Explicit
Sub Insert_X_Missing_Rows()
    Dim lrA    As Long
    Dim x      As Long
    Dim blk    As Long
    Dim cnt    As Long
    lrA = Range("A" & Rows.Count).End(xlUp).Row
    blk = lrA + 1
    For x = lrA To 1 Step -1                      'loop from bottom to top
        cnt = cnt + 1                             'count months present
        If Range("A" & x).Value = "" Or x = 1 Then 'search for blank cells in column A or if at top row
            If x = 1 Then cnt = cnt + 1           'count an extra blank since it's the top row
            Rows(blk & ":" & blk + 12 - cnt).Insert Shift:=xlDown 'insert missing rows
            cnt = 0
            blk = x
        End If
    Next x
End Sub

 

[Joe4]

Oh, I'm late, well anyway, here is what I came up with:

Option Explicit
Sub Insert_X_Rows()
    Dim lrA    As Long
    Dim x      As Long
    Dim blk    As Long
    Dim cnt    As Long
    lrA = Range("A" & Rows.Count).End(xlUp).Row
    blk = lrA + 1
    For x = lrA To 1 Step -1                      'loop from bottom to top
        cnt = cnt + 1
        If Range("A" & x).Value = "" Or x = 1 Then 'search for blank cells in column A or if at top row
            If x = 1 Then cnt = cnt + 1           'count a blank since it's the top row
            Rows(blk & ":" & blk + 12 - cnt).Insert Shift:=xlDown 'insert missing rows
            cnt = 0
            blk = x
        End If
    Next x
End Sub

It is always good to see other options and the other approaches others may take.
Some may work better than others, especially depending on the users' needs and how much data they have.

 

[BakerBaker]

It is always good to see other options and the other approaches others may take.
Some may work better than others, especially depending on the users' needs and how much data they have.

You might be "late" but this works as intended. Thank you for your assistance

 

[BakerBaker]

This is kind of a brute-force method of VBA (and I am sure that there are probably more efficient ways), but I think it gets the job done.
I am assuming that your data is in column A:

Sub MyInsertRows()

    Dim cell As Range
    Dim r1 As Long
    Dim r2 As Long
    Dim n As Long
  
'   Find first instance of "JAN"
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell.Value = "JAN" Then
            r1 = cell.Row
            Exit For
        End If
    Next cell
  
'   Message if cannot find "JAN"
    If r1 = 0 Then
        MsgBox "No instances of JAN found in column A", vbOKOnly, "ERROR!"
        Exit Sub
    End If
  
'   Loop through remaining rows, searching for next instance of JAN
    On Error GoTo leave_sub
    Do
'       Find row of next instance of "JAN"
        r2 = Range("A" & r1 & ":A" & Rows.Count).Find(What:="JAN", After:=Range("A" & r1), _
            LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Row
'       Determine number of rows to insert
        n = 13 - (r2 - r1)
        If n > 1 Then
'           Insert rows
            Rows(r2 - 1 & ":" & r2 + n - 3).Insert
'           Reset starting row
            r1 = r2 + n
        Else
'           Reset starting row
            r1 = r1 + 13
        End If
    Loop
    On Error GoTo 0
  
leave_sub:
    Err.Clear
    MsgBox "Macro complete!", vbOKOnly
  
End Sub

Thank you. There has been an additional reply which I have found to work as intended. However, thank you for your assistance

 

[Joe4]

You are welcome.
Glad we could help.

If you have a lot of data where it takes a little while to run, you could try to see if they both work for you, and which one seems faster.

 

[Joe4]

When marking a solution, be sure to mark the actual post, posted by that person, which contains the solution you went with.
So, it should be post 2 or 3, not my comments on rollis's post.

 

[rollis13]

Glad we were able to help.
On testing found (at least I think) that @Joe4's macro misses adding space for the first DEC row.
Also, in my version of Excel had to change LookIn:=xlFormulas2 to LookIn:=xlFormulas or omit it.

 

[Joe4]

Glad we were able to help.
On testing found (at least I thiink) that @Joe4 macro misses adding space for the first DIC row. In my version of Excel had to change LookIn:=xlFormulas2 to LookIn:=xlFormulas

Yes, older versions of Excel use a different argument there.

As regards to the other condition, it was a bit unclear to me if the meant to include that current blank row in the calculation or not of how many rows to insert, and we didn't have an image of the expected output, so I just "guessed" (maybe I guessed wrong). But my code could be easily amended if that is the case.