Add blank line after cell value has changed

[richertt]

Hi Guys,

I have a timeclock dump of data where column "A" = a person's name and column "B" is their clock in / clock out times. I want to add a blank line between each group of names. Searching google, I found this bt of code...

Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "ADD A LINE"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
For i = WorkRng.Rows.count To 2 Step -1
If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
WorkRng.Cells(i, 1).EntireRow.Insert
End If
Next
Application.ScreenUpdating = True

This works great except it prompts me to select the column to make it work (column A). The names are always in column A. How do I modify the code to automatically select column "A"?

Thanks in advance,

Troy

 

[Fluff]

Try

Sub AddRows()
   Dim i As Long, j As Long, lr As Long
   
   lr = Range("A" & Rows.Count).End(xlUp).Row
   Cells(lr + 2, 1).Resize(, 12).Interior.Color = 45678
   j = lr + 3
   For i = lr To 3 Step -1
      If Cells(i, 1) <> Cells(i - 1, 1) Then
         Rows(i).Resize(2).Insert
         Cells(i + 1, 1).Resize(, 12).Interior.Color = 45678
         Cells(j, 6).Formula = "=sum(" & Range("F" & i + 2).Resize(j - i - 2).Address & ")"
         j = i + 2
      End If
   Next i
End Sub