Insert Blank Rows

[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.

 

[Rick Rothstein \(MVP - VB\)]

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

 

[Rayashe]

GENIUS!!!!!

Thank you Rick.

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

 

[Rayashe]

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.

 

[Rick Rothstein \(MVP - VB\)]

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