Near the end of the code, XL can't find range "A1000".

Sub CRSPPPMod()
Dim Wksht As Worksheet
Dim lRow As Long
Dim rPay As Range
Dim rCell As Range
Dim rTtl As Range


Call Clean
lRow = 1000
Set Wksht = ActiveSheet
Wksht.Cells.RowHeight = 12.75

Wksht.Range("A8", "AE" & lRow).Select

Selection.UnMerge
Range("A10") = "Service County"

Range("B10") = "Service Provider Name"
Range("G10") = "Prov Id"
Range("H10") = "Lic Cert Type"
Range("I10") = "Effective Date"
Range("J10") = "Close Date"
Range("K10") = "Srvc Type"
Range("L10") = "Srvc Appr Status"
Range("O10") = "Gov Body Id"
Range("P10") = "Client Id"
Range("Q10") = "Client Last Name"
Range("R10") = "Client First Name"
Range("T10") = "Client State Id"
Range("U10") = "Client Srvc Begin Dt"
Range("V10") = "Client Srvd End Dt"
Range("W10") = "Pay Prvdr Y or N"
Range("Z10") = "IVE Entitlement Type"
Range("AC10") = "IVE Start Date"
Range("AE10") = "IVE End Date"

Range("W11").Activate


Set rPay = ActiveSheet.Range("W11", Cells(lRow, "W"))

For Each rCell In rPay
'rCell.Select

If rCell < "" Then
If rCell.Offset(0, -2) = "" Then

Range(rCell, rCell.Offset(0, 8)).Cut
Destination:=rCell.Offset(-1, 0)

End If
End If
Next

Range("F11:F" & lRow).Cut Destination:=Range("F11:F" & lRow).Offset(0,
1)
Range("AB11:AB" & lRow).Cut Destination:=Range("AB11:AB" &
lRow).Offset(0, 1)

Dim delRng As Range


Set rTtl = ActiveSheet.Range("a10:AE10")

For Each rCell In rTtl.Cells
rCell.Select

If rCell.Value = "" Then
If delRng Is Nothing Then

Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
Else
rCell.EntireColumn.AutoFit
End If
Next rCell

If delRng Is Nothing Then
'nothing to delete
Else
delRng.EntireColumn.Delete
End If

Wksht.Range("A:" & lRow).Activate<---RANGE METHOD FAILED

Selection.End(xlUp).Select

End Sub

Any suggestions?
Thanks for the help.

Hi,

Simply typoo - extraneous colon

Wksht.Range("A" & lRow).Activate


"davegb" wrote:

Near the end of the code, XL can't find range "A1000".

Sub CRSPPPMod()
Dim Wksht As Worksheet
Dim lRow As Long
Dim rPay As Range
Dim rCell As Range
Dim rTtl As Range


Call Clean
lRow = 1000
Set Wksht = ActiveSheet
Wksht.Cells.RowHeight = 12.75

Wksht.Range("A8", "AE" & lRow).Select

Selection.UnMerge
Range("A10") = "Service County"

Range("B10") = "Service Provider Name"
Range("G10") = "Prov Id"
Range("H10") = "Lic Cert Type"
Range("I10") = "Effective Date"
Range("J10") = "Close Date"
Range("K10") = "Srvc Type"
Range("L10") = "Srvc Appr Status"
Range("O10") = "Gov Body Id"
Range("P10") = "Client Id"
Range("Q10") = "Client Last Name"
Range("R10") = "Client First Name"
Range("T10") = "Client State Id"
Range("U10") = "Client Srvc Begin Dt"
Range("V10") = "Client Srvd End Dt"
Range("W10") = "Pay Prvdr Y or N"
Range("Z10") = "IVE Entitlement Type"
Range("AC10") = "IVE Start Date"
Range("AE10") = "IVE End Date"

Range("W11").Activate


Set rPay = ActiveSheet.Range("W11", Cells(lRow, "W"))

For Each rCell In rPay
'rCell.Select

If rCell < "" Then
If rCell.Offset(0, -2) = "" Then

Range(rCell, rCell.Offset(0, 8)).Cut
Destination:=rCell.Offset(-1, 0)

End If
End If
Next

Range("F11:F" & lRow).Cut Destination:=Range("F11:F" & lRow).Offset(0,
1)
Range("AB11:AB" & lRow).Cut Destination:=Range("AB11:AB" &
lRow).Offset(0, 1)

Dim delRng As Range


Set rTtl = ActiveSheet.Range("a10:AE10")

For Each rCell In rTtl.Cells
rCell.Select

If rCell.Value = "" Then
If delRng Is Nothing Then

Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
Else
rCell.EntireColumn.AutoFit
End If
Next rCell

If delRng Is Nothing Then
'nothing to delete
Else
delRng.EntireColumn.Delete
End If

Wksht.Range("A:" & lRow).Activate<---RANGE METHOD FAILED

Selection.End(xlUp).Select

End Sub

Any suggestions?
Thanks for the help.

Thanks, Toppers!