EntireRow Delete & Run-Time Error 1004 Issue

[KillerDragonKC]

I have the following code that i resulting in an error due to it is too complex and not a contiguous set of data.

I beleive it is due to there being too many rows for Excel to properly execute. I have scoured the forum to make something work in my favor, but have come up with incorrect solutions or improper implementations.

With DataWS
        .Range("B6:B" & LR).FormulaR1C1 = "=IF(ISNUMBER(SEARCH(""Co 90  Rg:"",RC[11])),RC[11]&RC[12],R[-1]C)"
        .Range("E9:E" & LR).FormulaR1C1 = "=IF(AND(RC[8]=R9C13,RC[9]<>R4C14),MID(RC[9],9,5),R[-1]C)"
        .Columns("B:E").Copy
        .Columns("B:E").PasteSpecial Paste:=xlPasteValues
        .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 9), Array(10, 2), Array(13, 9), Array(19, 2), Array(21, 9), _
            Array(25, 2), Array(28, 9)), TrailingMinusNumbers:=True
        .Range("B9").FormulaR1C1 = "RGN"
        .Range("C9").FormulaR1C1 = "DST"
        .Range("D9").FormulaR1C1 = "CTR"
        .Range("E9").FormulaR1C1 = "CREDIT PR"
        .Range("F9:AA9").FormulaR1C1 = "=TRIM(R[-2]C&"" ""&R[-1]C)"
        .Rows("9").Copy
        .Rows("9").PasteSpecial Paste:=xlPasteValues
        .Rows("1:8").Delete
        .Rows("1:1").AutoFilter
        .Range("$A$1:$AP$" & LR).AutoFilter Field:=24, Criteria1:=Array( _
            "APPLIED", "AS O", "OTHER", "RUN DAT", "="), Operator:=xlFilterValues
        .Rows("1").EntireRow.Hidden = True
        .Columns("A").SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
        .Rows("1").EntireRow.Hidden = False
    End With

Under normal circumstances the worksheets aren't nearly as extensive as the one I am currently working on, although I have encountered this issue in the past and had to manually do the deletions then continue the script to complete the process.

The error falls on the -- .Columns("A").SpecialCells(xlCellTypeVisible).EntireRow.Delete -- line of the code.

Any assistance on this issue is greatly appreciated.

 

[My Aswer Is This]

Tell us what your attempting to do.

 

[KillerDragonKC]

In this portion of the code it is filtering for the values "APPLIED" , "AS O", "OTHER", "RUN DAT" or blanks, then deleting the entire row which is on a sheet named "Data"

Normally the worksheets are not large enough to result in this error, but in the past couple of instances where I have ran this particular script, the sheets have been larger than normal.

Edit - Everything else in this script work flawlessly up to that line.

 

[Peter_SSs]

My guess is that you are using Excel 2007 or earlier and running into the SpecialCells limit problem

It is a bit hard with no sample data and only partial code but you could give this a try in a copy of your workbook.

I'm assuming that column AP is your last column and therefore column AQ can be used as a helper. If that is not the case, we need to use a column further to the right.

Replace the whole red section of code shown below with the blue section.

          .Rows("9").PasteSpecial Paste:=xlPasteValues
          .Rows("1:8").Delete

         <del> .Rows("1:1").AutoFilter
          .Range("$A$1:$AP$" & LR).AutoFilter Field:=24, Criteria1:=Array( _
              "APPLIED", "AS O", "OTHER", "RUN DAT", "="), Operator:=xlFilterValues
          .Rows("1").EntireRow.Hidden = True
          .Columns("A").SpecialCells(xlCellTypeVisible).EntireRow.Delete
          .AutoFilterMode = False
          .Rows("1").EntireRow.Hidden = False</del>
     
          Dim ColX As Variant
          Dim i As Long, lCount As Long
          
          ColX = Range("X2:X" & LR).Value
          For i = 1 To UBound(ColX)
            Select Case ColX(i, 1)
              Case "APPLIED", "AS O", "OTHER", "RUN DAT", "="
                ColX(i, 1) = 1
                lCount = lCount + 1
              Case Else
                ColX(i, 1) = vbNullString
            End Select
          Next i
          If lCount > 0 Then
            With .Range("A2:AQ" & LR)
              .Columns(.Columns.Count).Value = ColX
              .Sort Key1:=.Columns(.Columns.Count), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
                  MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
              .Resize(lCount).EntireRow.Delete
            End With
          End If
     
    End With