VBA help - Insert n blanks lines after every n line

[NeoSez]

I am trying create a code to insert N# of lines after every N# of lines.
I had one but accidentally overwrote it and can not find the source again.
The script would prompt and ask how many blank lines I would like to insert.
Then it prompted again asking after how many lines before inserting # of blank lines.
It worked really well for my needs.
Please help!
Thank you.

 

[BigBeachBananas]

How about this?

Sub InsertBlankLines()
    Dim NumBlankLines As Long
    Dim LinesBeforeInsert As Long
    Dim CurrentRow As Long
    Dim LastRow As Long
    Dim i As Long

    NumBlankLines = Application.InputBox("How many blank lines do you want to insert?", Type:=1)

    LinesBeforeInsert = Application.InputBox("After how many lines do you want to insert " & NumBlankLines & " blank lines?", Type:=1)

    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    CurrentRow = 1

    For i = 1 To LastRow
        CurrentRow = CurrentRow + 1
        If CurrentRow Mod LinesBeforeInsert = 0 Then
            Rows(CurrentRow + 1 & ":" & CurrentRow + NumBlankLines).Insert Shift:=xlDown
            CurrentRow = CurrentRow + NumBlankLines
            LastRow = LastRow + NumBlankLines
        End If
    Next i
End Sub

 

[NeoSez]

How about this?

Sub InsertBlankLines()
    Dim NumBlankLines As Long
    Dim LinesBeforeInsert As Long
    Dim CurrentRow As Long
    Dim LastRow As Long
    Dim i As Long

    NumBlankLines = Application.InputBox("How many blank lines do you want to insert?", Type:=1)

    LinesBeforeInsert = Application.InputBox("After how many lines do you want to insert " & NumBlankLines & " blank lines?", Type:=1)

    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    CurrentRow = 1

    For i = 1 To LastRow
        CurrentRow = CurrentRow + 1
        If CurrentRow Mod LinesBeforeInsert = 0 Then
            Rows(CurrentRow + 1 & ":" & CurrentRow + NumBlankLines).Insert Shift:=xlDown
            CurrentRow = CurrentRow + NumBlankLines
            LastRow = LastRow + NumBlankLines
        End If
    Next i
End Sub

Thank you for your reply.
I just tried to select the lines that I want to have blank lines inserted into and it threw me an error: "Compile Error: Invalid Outside Procedure." I don't know what this means.

 

[kevin9999]

I've no idea what your data layout is like, but this assumes that you have headers on row 1, and your data starts on row 2. Please try it on a copy of your workbook (just change the sheet name to suit).

Option Explicit
Sub InsertRows()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    Dim LRow As Long, LCol As Long, rng As Range
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    
    Dim i As Long, j As Long, k As Long, a
    i = Application.InputBox("Enter the number of blank rows you want between rows", "Rows to insert", , , , , , 1)
    j = Application.InputBox("Start inserts after which row?", "Row Number", , , , , , 1)
    i = Int(i): j = Int(j)
    Set rng = ws.Range(ws.Cells(j, LCol), ws.Cells(LRow, LCol))
    With rng
        .Value2 = Evaluate("row(" & .Address & ")")
        a = rng
        For k = 1 To i
            rng.Copy rng.Offset(rng.Rows.Count)
            ws.Cells((LRow * k) + 1, LCol).Resize(UBound(a, 1)).Value = a
        Next k
    End With
    ws.Range(ws.Cells(2, LCol), ws.Cells(i, LCol)).Value = 0
    
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=Columns(LCol), Order1:=xlAscending, Header:=xlNo
    ws.Columns(LCol).ClearContents
    Application.ScreenUpdating = True
End Sub