J
jlclyde
Here is the code that I am using and it is stored in the worksheet
itself. Is this the problem? Why else woudl I be getting Object
Required error?
Thanks,
Jay
Sub HeidDay()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim i, c
Dim Rng As Range
Dim Rnge As Range
Dim Target As Range
Range("A5:HW1000").Sort Key1:=Range("A5"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Set Target = Sheet19.Range("A5")
Do Until Target.Value = ""
If Target.Value <= Date - 90 And DatePart("ww", Target.Value)
= _
DatePart("ww", Target.Offset(1, 0).Value) Then
Set Rng = Sheet19.Range(Cells(Target.Row, 2), _
Cells(Target.Row, 41))
Set Rnge = Sheet19.Range(Cells(Target.Row, 207), _
Cells(Target.Row, 220))
For Each i In Rng
If IsNumeric(i.Value) And
IsNumeric(i.Offset(1, 0).Value) Then
i.Value = i.Value + i.Offset(1, 0).Value
End If
Next i
For Each c In Rnge
If IsNumeric(c.Value) And
IsNumeric(c.Offset(1, 0).Value) Then
c.Value = c.Value + c.Offset(1, 0).Value
End If
Next c
Sheet19.Range(Cells(i.Row + 1, 1), Cells(i.Row + 1,
41)).Delete _
Shift:=xlUp
Sheet19.Range(Cells(c.Row + 1, 207), Cells(c.Row + 1,
220)). _
Delete Shift:=xlUp
Else
GoTo P
End If
P:
Set Target = Target.Offset(1, 0)
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
itself. Is this the problem? Why else woudl I be getting Object
Required error?
Thanks,
Jay
Sub HeidDay()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim i, c
Dim Rng As Range
Dim Rnge As Range
Dim Target As Range
Range("A5:HW1000").Sort Key1:=Range("A5"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Set Target = Sheet19.Range("A5")
Do Until Target.Value = ""
If Target.Value <= Date - 90 And DatePart("ww", Target.Value)
= _
DatePart("ww", Target.Offset(1, 0).Value) Then
Set Rng = Sheet19.Range(Cells(Target.Row, 2), _
Cells(Target.Row, 41))
Set Rnge = Sheet19.Range(Cells(Target.Row, 207), _
Cells(Target.Row, 220))
For Each i In Rng
If IsNumeric(i.Value) And
IsNumeric(i.Offset(1, 0).Value) Then
i.Value = i.Value + i.Offset(1, 0).Value
End If
Next i
For Each c In Rnge
If IsNumeric(c.Value) And
IsNumeric(c.Offset(1, 0).Value) Then
c.Value = c.Value + c.Offset(1, 0).Value
End If
Next c
Sheet19.Range(Cells(i.Row + 1, 1), Cells(i.Row + 1,
41)).Delete _
Shift:=xlUp
Sheet19.Range(Cells(c.Row + 1, 207), Cells(c.Row + 1,
220)). _
Delete Shift:=xlUp
Else
GoTo P
End If
P:
Set Target = Target.Offset(1, 0)
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub