VBA - Adding Rows

[halem2]

Hi folks:

this is the scenario: I have a spreadsheet organized by employe
number and pay types (Reg pay, Overtime, Bonus, Misc). Sme employee
have 1 pay type, some have two, some 3 and some 4. I need to add row
to those employees that have less than 4 pay types to make it 4. Al
employees should have 4 rows.

this is what I've been working with:

Do
If ActiveCell = ActiveCell.Offset(1, 0) Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
End If
Loop Until ActiveCell = ""

thanks for the help:confused

 

[Bob Phillips]

Try this

Sub AddRows()
Dim cLastRow As Long
Dim nRow As Long
Dim nCol As Long
Dim cRows As Long
Dim i As Long

With ActiveCell
nRow = .Row
nCol = .Column
End With

cLastRow = Cells(Rows.Count, nCol).End(xlUp).Row

For i = cLastRow To nRow Step -1
cRows = 1
Do While Cells(i, nCol).Value = Cells(i - cRows, nCol).Value
cRows = cRows + 1
Loop
If cRows < 4 Then
Cells(i + 1, nCol).Resize(4 - cRows, 1).EntireRow.Insert
End If
i = i - cRows + 1
Next i

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)