Insert Blank Rows
 

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.

Insert Blank Rows
 

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" wrote in message
...
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.

Insert Blank Rows
 

GENIUS!!!!!

Thank you Rick.

"Rick Rothstein (MVP - VB)" wrote:

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" wrote in message
...
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.

Insert Blank Rows
 

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)" wrote:

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" wrote in message
...
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.

Insert Blank Rows
 

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



"Rayashe" wrote in message
...
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)" wrote:

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" wrote in message
...
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.