Code To Insert Blank Rows

  • Thread starter Thread starter MWS-C360
  • Start date Start date
M

MWS-C360

I have a file with a listing of entries, and in column B of all the entries,
are unique names. I need to create the code to reference the listing, which
at times will be 200 entries and other times 1000 entries, and evaluate the
data in column B, to then insert 2 blank rows every time a different name
appears. For instance

Initially column B has
(Row 1) Pears
(2) Pears
(3) Pears
(4) Apples
(5) Grapes
(6) Grapes

After the desired code, the results would be..
(Row 1) Pears
(2) Pears
(3) Pears
(4) Blank Row
(5) Blank Row
(6) Apples
(7) Blank Row
(8) Blank Row
(9) Grapes
(10) Grapes
END OF FILE

Any and all help will be appreciated - Thank You In Advance
 
Try this which will ignore previously inserted blank rows:

Sub InsertRows()
Dim LastRow As Long
Dim CheckValue As String

LastRow = Range("B" & Rows.Count).End(xlUp).Row
CheckValue = Range("B" & LastRow).Value

For r = LastRow To 1 Step -1
If CheckValue <> Range("B" & r) And Range("B" & r) <> "" Then
CheckValue = Range("B" & r).Value
Range("B" & r + 1).Resize(2).EntireRow.Insert
End If
Next
End Sub


Regards,
Per
 
Rows(lngRow).EntireRow.Resize(2).Insert

Since you used the Rows object in the above line from your posted code, you
don't need to specify the EntireRow property... this should work the same
way...

Rows(lngRow).Resize(2).Insert
 
Range("B" & r + 1).Resize(2).EntireRow.Insert

For the above line from your posted code, you could use Rows instead of
Range and do away with the call to the EntireRow property...

Rows(r + 1).Resize(2).Insert
 
Yes Rick. I initially wrote that as Range() and later changed that to
Rows()...missed to remove that. Thanks for pointing that out..
 
Back
Top