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

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

I'm not sure why your code breaks, but you have a few problems with unqualified
ranges. And instead of using a couple of GoTo's, I looped through the row
numbers and incremented a counter if the row was not deleted. I kept this
counter the same so that the next row would be compared.

I _think_ that this does the same as your code, but you'll want to test (against
a copy of your worksheet???):

Option Explicit
Sub HkIps2()
Dim i As Range
Dim iRow As Long
Dim FirstRow As Long
Dim c As Range
Dim rng As Range
Dim rng2 As Range
Dim LstRow As Long
Dim LstCol As Long

With Sheet1
FirstRow = 5
LstCol = .Range("a4").End(xlToRight).Column
LstRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'I changed header:=xlguess to xlno. I figured row 4
'is the header row.
.Range(.Cells(5, 1), .Cells(LstRow, LstCol)).Sort _
key1:=.Range("E5"), Order1:=xlAscending, _
Key2:=Range("A5"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Set rng = .Range("A5:A" & LstRow)

iRow = FirstRow
Do
Set i = .Cells(iRow, "A")
If i.Value = "" Then
Exit Do
Else
If DatePart("ww", i.Value) _
= DatePart("ww", i.Offset(1, 0).Value) _
And i.Offset(0, 5).Value = i.Offset(1, 5).Value _
And i.Value < (Date - 90) Then
Set rng2 = .Range(.Cells(i.Row, 6), .Cells(i.Row, LstCol))
For Each c In rng2.Cells
c.Value = c.Value + c.Offset(1, 0).Value
Next c
'MsgBox i.Address
'delete the next row that was added to the "current" row
.Rows(iRow + 1).Delete
'keep irow the same
'irow = irow 'just a comment.
Else
'go to the next row
iRow = iRow + 1
End If
End If
Loop
End With
End Sub

jlclyde wrote:

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

--

Dave Peterson

On Nov 5, 5:03*pm, Dave Peterson wrote:
I'm not sure why your code breaks, but you have a few problems with unqualified
ranges. *And instead of using a couple of GoTo's, I looped through the row
numbers and incremented a counter if the row was not deleted. *I kept this
counter the same so that the next row would be compared.

I _think_ that this does the same as your code, but you'll want to test (against
a copy of your worksheet???):

Option Explicit
Sub HkIps2()
* * Dim i As Range
* * Dim iRow As Long
* * Dim FirstRow As Long
* * Dim c As Range
* * Dim rng As Range
* * Dim rng2 As Range
* * Dim LstRow As Long
* * Dim LstCol As Long

* * With Sheet1
* * * * FirstRow = 5
* * * * LstCol = .Range("a4").End(xlToRight).Column
* * * * LstRow = .Cells(.Rows.Count, "A").End(xlUp).Row

* * * * 'I changed header:=xlguess to xlno. *I figured row 4
* * * * 'is the header row.
* * * * .Range(.Cells(5, 1), .Cells(LstRow, LstCol)).Sort _
* * * * * * key1:=.Range("E5"), Order1:=xlAscending, _
* * * * * * Key2:=Range("A5"), Order2:=xlAscending, _
* * * * * * Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
* * * * * * Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

* * * * Set rng = .Range("A5:A" & LstRow)

* * * * iRow = FirstRow
* * * * Do
* * * * * * Set i = .Cells(iRow, "A")
* * * * * * If i.Value = "" Then
* * * * * * * * Exit Do
* * * * * * Else
* * * * * * * * If DatePart("ww", i.Value) _
* * * * * * * * * * * * = DatePart("ww", i.Offset(1, 0).Value) _
* * * * * * * * *And i.Offset(0, 5).Value = i.Offset(1, 5).Value _
* * * * * * * * *And i.Value < (Date - 90) Then
* * * * * * * * * * Set rng2 = .Range(.Cells(i.Row, 6), .Cells(i.Row, LstCol))
* * * * * * * * * * For Each c In rng2.Cells
* * * * * * * * * * * * c.Value = c.Value + c.Offset(1, 0).Value
* * * * * * * * * * Next c
* * * * * * * * * * 'MsgBox i.Address
* * * * * * * * * * 'delete the next row that was added to the "current" row
* * * * * * * * * * .Rows(iRow + 1).Delete
* * * * * * * * * * 'keep irow the same
* * * * * * * * * * 'irow = irow 'just a comment.
* * * * * * * * Else
* * * * * * * * * * 'go to the next row
* * * * * * * * * * iRow = iRow + 1
* * * * * * * * End If
* * * * * * End If
* * * * Loop
* * End With
End Sub





jlclyde wrote:

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

--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,
Thanks for this. If I run it twice then it picks up all the rows it
needs to. I am not sure why this is. It seems to be written to do
exactly what I want.
Thanks,
Jay

The portion that does the work is:

If DatePart("ww", i.Value) _
= DatePart("ww", i.Offset(1, 0).Value) _
And i.Offset(0, 5).Value = i.Offset(1, 5).Value _
And i.Value < (Date - 90) Then
Set rng2 = .Range(.Cells(i.Row, 6), .Cells(i.Row, LstCol))
For Each c In rng2.Cells
c.Value = c.Value + c.Offset(1, 0).Value
Next c
'MsgBox i.Address
'delete the next row that was added to the "current" row
.Rows(iRow + 1).Delete
'keep irow the same
'irow = irow 'just a comment.
Else
'go to the next row
iRow = iRow + 1
End If

So if you meet a (complex) criteria, then you delete the next row (irow+1), but
you "stay on" the same row in the loop. So you can compare the current row with
the 3rd row (now the next row after the deletion).

If you fail to meat that criteria, then you add one to the irow and start with
the next comparison.

jlclyde wrote:

<<snipped

Dave,
Thanks for this. If I run it twice then it picks up all the rows it
needs to. I am not sure why this is. It seems to be written to do
exactly what I want.
Thanks,
Jay

--

Dave Peterson