J
jlclyde
Code Below: I am trying to look at the Dates Which are in A and the
Employee Numbers which are in E. I want to sort the entire range by A
then E. After it is sorted the Target.Range is A5. I want to compare
the week of the Target to the week of the Target.Offset(1,0). I also
want to compare the emp# to emp#.Offset(1,0). If these are both the
same then I am setting a the range to add up. then delete the next
row as not to add them up again. then loop through again. If there
is an easier way to do this or if you can answer why it keeps bugging
out on the last end if, I woudl greatly appreciate it.
Thanks,
Jay
Sub HKIPS()
Dim i, c
Dim Rng As Range
Dim Target As Range
Dim lstRow As Long
Dim lstCol As Long
lstCol = Sheet1.Range("A4").End(xlToRight).Column
lstRow = Sheet1.Range("A65536").End(xlUp).Row
Set Target = Sheet1.Range("A5")
Sheet1.Range(Cells(5, 1), Cells(lstRow, lstCol)).Sort
key1:=Range("A5"), _
Order1:=xlAscending, Key2:=Range("E5"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Do Until Target = ""
If Target.Value <= Date - 548 Then
Set Target = Target.Offset(1, 0)
Target.Offset(-1, 0).EntireRow.Delete
GoTo P
Else
If DatePart("ww", Target.Value) = _
DatePart("ww", Target.Offset(1, 0).Value) And _
DatePart("ww", Target.Value) <= Date - 90 And _
Target.Offset(0, 4).Value = Target.Offset(1,
4).Value Then
Set Rng = Range(Cells(Target.Row, 6), Cells(Target.Row,
lstCol))
For Each i In Rng
i.Value = i.Value + i.Offset(1, 0).Value
Next i
Target.Offset(1, 0).EntireRow.Delete
End If
End If
Set Target = Target.Offset(1, 0)
P:
Loop
End Sub
Employee Numbers which are in E. I want to sort the entire range by A
then E. After it is sorted the Target.Range is A5. I want to compare
the week of the Target to the week of the Target.Offset(1,0). I also
want to compare the emp# to emp#.Offset(1,0). If these are both the
same then I am setting a the range to add up. then delete the next
row as not to add them up again. then loop through again. If there
is an easier way to do this or if you can answer why it keeps bugging
out on the last end if, I woudl greatly appreciate it.
Thanks,
Jay
Sub HKIPS()
Dim i, c
Dim Rng As Range
Dim Target As Range
Dim lstRow As Long
Dim lstCol As Long
lstCol = Sheet1.Range("A4").End(xlToRight).Column
lstRow = Sheet1.Range("A65536").End(xlUp).Row
Set Target = Sheet1.Range("A5")
Sheet1.Range(Cells(5, 1), Cells(lstRow, lstCol)).Sort
key1:=Range("A5"), _
Order1:=xlAscending, Key2:=Range("E5"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Do Until Target = ""
If Target.Value <= Date - 548 Then
Set Target = Target.Offset(1, 0)
Target.Offset(-1, 0).EntireRow.Delete
GoTo P
Else
If DatePart("ww", Target.Value) = _
DatePart("ww", Target.Offset(1, 0).Value) And _
DatePart("ww", Target.Value) <= Date - 90 And _
Target.Offset(0, 4).Value = Target.Offset(1,
4).Value Then
Set Rng = Range(Cells(Target.Row, 6), Cells(Target.Row,
lstCol))
For Each i In Rng
i.Value = i.Value + i.Offset(1, 0).Value
Next i
Target.Offset(1, 0).EntireRow.Delete
End If
End If
Set Target = Target.Offset(1, 0)
P:
Loop
End Sub