sort and delete rows of information

[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

 

[jlclyde]

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

 

[Dave Peterson]

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]

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












--

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

 

[Dave Peterson]

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.