Here is some new code that I am trying to get to work to complete the
same task. It is now bugging out on i.Offset(1, 0).EntireRow.Delete.
Any Help?
Thanks,
Jay
Sub HkIps2()
Dim i, c
Dim rng As Range, rng2 As Range
Dim LstRow As Long, LstCol As Long
LstCol = Range("a4").End(xlToRight).Column
LstRow = Range("A65536").End(xlUp).Row

Sheet1.Range(Cells(5, 1), Cells(LstRow, LstCol)).Sort
key1:=Range("E5"), _
Order1:=xlAscending, Key2:=Range("A5"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


Set rng = Range("A5:A" & LstRow)
For Each i In rng
P:
If i.Value = "" Then
Exit Sub
Else
If DatePart("ww", i) = DatePart("ww", i.Offset(1, 0).Value)
And _
i.Offset(0, 5).Value = i.Offset(1, 5).Value And i < Date -
90 Then
Set rng2 = Range(Cells(i.Row, 6), Cells(i.Row,
LstCol))

For Each c In rng2
c = c + c.Offset(1, 0).Value
Next c
MsgBox (i.Address)
i.Offset(1, 0).EntireRow.Delete
GoTo P
Else
GoTo g
End If
End If
g:
Next i
End Sub