Insert rows on change of cell value 1

[stillwillyboy]

I am needing to insert two rows after a change in an employee number. I will then need to do some calculation for each employee, i.e. adding up hours and pay. Example:

04-03-06 1234 Bob 6.0
04-04-06 1234 Bob 6.0
04-05-06 1234 Bob 6.0
04-06-06 1234 Bob 6.0
04-07-06 1234 Bob 6.0
04-03-06 4567 Joe 7.0
04-04-06 4567 Joe 7.0
04-05-06 4567 Joe 7.0
04-06-06 4567 Joe 7.0
04-07-06 4567 Joe 7.0
04-03-06 9999 Sue 5.0
04-04-06 9999 Sue 5.0

Would be:
04-03-06 1234 Bob 6.0
04-04-06 1234 Bob 6.0
04-05-06 1234 Bob 6.0
04-06-06 1234 Bob 6.0
04-07-06 1234 Bob 6.0
30.0

04-03-06 4567 Joe 7.0
04-04-06 4567 Joe 7.0
04-05-06 4567 Joe 7.0
04-06-06 4567 Joe 7.0
04-07-06 4567 Joe 7.0
35.0

04-03-06 9999 Sue 5.0
04-04-06 9999 Sue 5.0
10.0

I have the following code, but it gives me the two needed rows after the third Bob, not the fifth Bob. It then bails when the activecell is empty before the end of the data, (which I understand if the activecell is empty, it should.) I have tried various combinations of = and <> as well as the offsets.

Sub SeparateClients()
Application.StatusBar = "Separating Clients"
Application.ScreenUpdating = False
Sheets("TimeSheetEntry").Select
Range("B2").Select
On Error Resume Next
Do Until ActiveCell = ""
With ActiveCell
If ActiveCell.Value <> ActiveCell(-1, 0).Value Then
.Offset(1, 0).Select
Else
With ActiveCell
.Offset(1, 0).Select
.Offset(1, 0).EntireRow.Insert
.Offset(1, 0).EntireRow.Insert
End With
End If
End With
With ActiveCell
.Offset(1, 0).Select
End With
Loop
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

TIA

Bill

 

[PHV]

Why not simply use menu Data -> Subtotals ... ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[stillwillyboy]

I sure try to make things harder than they should be.

Thanks PHV.

Bill