Insert Blank Rows

  • Thread starter Thread starter Rayashe
  • Start date Start date
R

Rayashe

I have all my clients sorted in a sheet with column A containing month 1, 2,
3, 4, up to 12 - then column B has the client code, column C client Surname
and Name.

I need to insert 2 rows after each client and need a code to be able to do
this as there are over 500 clients.

I have filtered to show unique on column B, and to do a simple keystroke is
DOWN, DOWN, DOWN, INSERT ROW, INSERT ROW.

The problem is that some clients started and ended at various times during
the year, so not all have the same number of entries.
 
A subroutine like this should work (just change the worksheet reference from
Sheet1 to your actual worksheet name)...

Sub InsertTwoRows()
Dim X As Long
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = LastRow - 1 To 1 Step -1
If Len(.Cells(X, "B").Value) > 0 And _
Len(.Cells(X + 1, "B").Value) > 0 And _
.Cells(X, "B").Value <> .Cells(X + 1, "B").Value Then
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
End If
Next
End With
End Sub


Rick
 
GENIUS!!!!!

Thank you Rick.

Rick Rothstein (MVP - VB) said:
A subroutine like this should work (just change the worksheet reference from
Sheet1 to your actual worksheet name)...

Sub InsertTwoRows()
Dim X As Long
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = LastRow - 1 To 1 Step -1
If Len(.Cells(X, "B").Value) > 0 And _
Len(.Cells(X + 1, "B").Value) > 0 And _
.Cells(X, "B").Value <> .Cells(X + 1, "B").Value Then
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
End If
Next
End With
End Sub


Rick
 
Hi Rick,
Following on to this (I probably should have added it in on the first query):
In the one blank row that has now been created after each client, I need to
put a total in columns D, E, F, G & H.
Again due to the differences in number of months per client it is not a case
of just simply copying the formula.
 
Does this subroutine do what you want?

Sub InsertTwoRows()
Dim X As Long
Dim Z As Long
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = LastRow To 1 Step -1
If X = LastRow Or (Len(.Cells(X, "B").Value) > 0 And _
Len(.Cells(X + 1, "B").Value) > 0 And _
.Cells(X, "B").Value <> .Cells(X + 1, "B").Value) Then
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "B").EntireRow.Insert xlShiftDown
.Cells(X + 1, "C").Value = "Totals: "
.Cells(X + 1, "C").HorizontalAlignment = xlRight
End If
Next
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For X = 1 To LastRow
If .Cells(X, "C").Value = "Totals: " Then
For Z = 4 To 8
Cells(X, Z).Formula = "=SUM(" & Chr$(Z + 64) & _
Cells(X, "C").End(xlUp).Row & ":" & _
Chr$(Z + 64) & (X - 1) & ")"
Next
End If
Next
End With
End Sub


Rick
 
Back
Top