Insert 2 blank lines after each current area

Question

I need to insert 2 blank rows after each current data region in Excel.

Theoretically, my code should work and insert it AFTER the data, but after reusing it so many times, it inserts it before the data not after.

Where am I wrong? Can someone kindly guide me? Thanks!

Sub AutoInsert2BlankRows() Selection.CurrentRegion.Select SendKeys "^{.}" SendKeys "^{.}" SendKeys "~" ActiveCell.EntireRow.Select 'this chooses the whole row Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDown End Sub 

Here is my photo for further clarification. As you can see, there are 3 different current areas, separated by an empty string. I need to insert two more blank lines in addition to the already existing blank line in order to make 3 blank lines between each current area. (Apologies if I had not been clear enough before.)

Here is the link to the image!

Answer 1

Is this what you are trying to do?

1st example

 Sub AutoInsert2BlankRows() ' // Set Variables. Dim Rng As Range Dim i As Long ' // Target Range. Set Rng = Range("A2:A10") ' // Reverse looping For i = Rng.Rows.Count To 2 Step -1 ' // Insert two blank rows. Rng.Rows(i).EntireRow.Insert Rng.Rows(i).EntireRow.Insert ' // Increment loop Next i End Sub 

---

Edit

To add two more blank lines after each blank line, try the following.

Second example

 Sub AutoInsert2BlankRows() ' // Set Variables. Dim Rng As Range Dim i As Long ' // Target Range. Set Rng = Range("A2:A10") ' // Reverse looping For i = Rng.Rows.Count To 2 Step -1 If Cells(i, 1).Value = 0 Then ' // Insert two blank rows. Rng.Rows(i).EntireRow.Insert Rng.Rows(i).EntireRow.Insert End If ' // Increment loop Next i End Sub 

---

3rd example

 Option Explicit Sub AutoInsert2BlankRows() ' // Set Variables. Dim Rng As Range Dim i As Long ' // Target Range. Set Rng = ActiveSheet.UsedRange ' // Reverse looping For i = Rng.Rows.Count To 1 Step -1 ' // If entire row is empty then If Application.CountA(Rows(i).EntireRow) = 0 Then ' // Insert blank row Rows(i).Insert Rows(i).Insert End If Next i End Sub 

Answer 2

If you capture all xlCellTypeConstants with the Range.SpecialCells in the Worksheet.UsedRange property , you will have several non-adjacent Scopes . They are equal to the Range.CurrentRegion property . Go through them and insert the lines as you wish.

 Sub autoInsertTwoBlankRows() Dim a As Long With Worksheets("Sheet1") With .UsedRange.SpecialCells(xlCellTypeConstants) For a = .Areas.Count To 1 Step -1 With .Areas(a).Cells(1, 1).CurrentRegion .Cells(.Rows.Count, 1).Offset(1, 0).Resize(2, .Columns.Count).Insert _ Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove End With Next a End With End With End Sub 

If your data contains both formulas and typed constants, then this is more suitable.

 Sub autoInsertTwoBlankRows() Dim a As Long, ur As Range With Worksheets("Sheet1").Cells With Union(.SpecialCells(xlCellTypeConstants), _ .SpecialCells(xlCellTypeFormulas)) For a = .Areas.Count To 1 Step -1 With .Areas(a).Cells(1, 1).CurrentRegion .Cells(.Rows.Count, 1).Offset(1, 0).Resize(2, .Columns.Count).Insert _ Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove End With Next a End With End With End Sub 

When inserting rows, try to work from the bottom up so that moving the rows does not affect further operations. It is for this reason that I started working with the last Region and worked on the first.

^{data before autoincrementTwoBlankRows data islands after autoInsertTwoBlankRows}

Answer 3

Updated: Thanks for the trick.

  Sub AutoInsert2BlankRows ()
         With application
             .ScreenUpdating = False
             .EnableEvents = False
             .Calculation = xlCalculationManual
         End with

 Dim lastRow As Long, x As Long lastRow = Cells.Find(What:="*", _ After:=Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row For x = lastRow To 2 Step -1 If WorksheetFunction.CountA(Rows(x)) > 0 And WorksheetFunction.CountA(Rows(x + 1)) = 0 Then Rows(x + 1 & ":" & x + 2).Insert Shift:=xlDown End If Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub 

/ to>

Two lines were inserted after A, B, C and E, but not between D and E, because they overlap.

Answer 4

(What does "~" do?)

Make sure the selection is somewhere in this region. With your code Ctrl-. probably does not move to the last cell, depending on where the activation is activated when it starts. I would use:

 Dim rng As Range Application.ScreenUpdating = False Set rng = Selection.CurrentRegion Set rng = rng(rng.Count + 1) 'the last cell + 1 row rng.EntireRow.Rows("1:2").Insert shift:=xlDown 

Answer 5

This worked for me using Excel 2007.

 Sub AutoInsert2BlankRows() Dim rng As Range Set rng = Selection.End(xlDown).EntireRow rng.Offset(1).Insert Shift:=xlDown rng.Offset(1).Insert Shift:=xlDown End Sub 

I adapted and simplified the code in the question, mainly to avoid cell selection. The user has selected a cell in the region in which they want to insert two rows after. The rng variable first moves to the bottom of the area, then the entire line is selected. Two lines are inserted before rng , where rng been shifted one line to make sure that they are after the region of interest. I am sure that two lines can be inserted as one command, but I don’t know yet how to do this.

Answer 6

this will not add extra lines after the last "current area"

 Sub AutoInsert2BlankRows() With Worksheets("mySheet").UsedRange '<-- change "mySheet" as per your actual sheet name With .Offset(, .Columns.Count).Resize(, 1) .FormulaR1C1 = "=IF(counta(RC1:RC[-1])>0,1,"""")" .Value = .Value With .SpecialCells(xlCellTypeBlanks).EntireRow .Insert Shift:=xlDown .Insert Shift:=xlDown End With .Clear End With End With End Sub