Error 1004 - Delete Method of Range Class Failed

G

genheals

New Member
Joined
Jan 21, 2017
Messages
4
Good morning,

I am attempting to sort a table of data, specify via the table filter function any numbers less than 2, select all rows of data meeting this criteria via special go to (visible cells only), paste these rows into a new sheet, and then delete the resulting empty rows. Unfortunately, I get this error when I attempt to do so:

Error 1004 - Delete Method of Range Class Failed

Can anyone lend assistance with this error?

Code: 
Sub TESTNEW()
'
' SORT Macro
'


'
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("N:N").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14, Criteria1:= _
        "<=1", Operator:=xlAnd
    Range("Table1").Select
    Range("C15").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste
    Sheets("XT18053").Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14
    Range("H18").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14, Criteria1:= _
        ">=1", Operator:=xlAnd, Criteria2:="<=2"
    Range("Table1").Select
    Range("B11").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.SmallScroll ToRight:=4
    Columns("K:K").Select
    Selection.Copy
    Range("Q1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$Q$1:$Q$4094").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=SUMIFS(C14,C11,RC[-1])"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=SUMIFS(C15,C11,RC[-2])"
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Debit"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "Credit"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "Total"
    Range("R2:T2").Select
    Selection.AutoFill Destination:=Range("R2:T442"), Type:=xlFillDefault
    Range("R2:T442").Select
    ActiveWindow.ScrollRow = 402
    ActiveWindow.ScrollRow = 379
    ActiveWindow.ScrollRow = 313
    ActiveWindow.ScrollRow = 190
    ActiveWindow.ScrollRow = 95
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 1
    Range("Q1:T442").Select
    Selection.Cut
    Sheets("Sheet3").Select
    ActiveSheet.Paste
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$442"), , xlYes).Name = _
        "Table2"
    Range("Table2[#All]").Select
    ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
    Range("B6").Select
    ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=1, Criteria1:="="
    Range("Table2").Select
    Range("A253").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Delete
    ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=1
    Range("Table2[#All]").Select
    Selection.Cut
    Sheets("XT18053").Select
    Range("Q1").Select
    ActiveSheet.Paste
    Sheets("Sheet3").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("XT18053").Select
    Range("U13").Select
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "FTE Tracking"
    Sheets("XT18053").Select
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table2").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table2").Sort.SortFields.Add _
        Key:=Range("Table2[[#All],[Reference Number]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("XT18053").ListObjects("Table2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table1").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table1").Sort.SortFields.Add _
        Key:=Range("Table1[[#All],[Reference Number]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("XT18053").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Sort by date Sort by votes
slightly tidier, but I cannot visual what this does

Code: 
Sub TESTNEW()
'
' SORT Macro
    On Error Resume Next
    Columns("N:N").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14, Criteria1:= _
                                                       "<=1", Operator:=xlAnd

    Range("Table1").Select
    Range("C15").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste

    Sheets("XT18053").Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14
    Range("H18").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14, Criteria1:= _
                                                       ">=1", Operator:=xlAnd, Criteria2:="<=2"

    Range("Table1").Select
    Range("B11").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14

    Columns("K:K").Select
    Selection.Copy
    Range("Q1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    ActiveSheet.Range("$Q$1:$Q$4094").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("R2").FormulaR1C1 = "=SUMIFS(C14,C11,RC[-1])"
    Range("S2").FormulaR1C1 = "=SUMIFS(C15,C11,RC[-2])"
    Range("T2").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("R1") = "Debit"
    Range("S1") = "Credit"
    Range("T1") = "Total"

    Range("R2:T2").Select
    Selection.AutoFill Destination:=Range("R2:T442"), Type:=xlFillDefault
    Range("R2:T442").Select
    Range("Q1:T442").Select
    Selection.Cut

    Sheets("Sheet3").Select
    ActiveSheet.Paste
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$442"), , xlYes).Name = _
    "Table2"
    Range("Table2[#All]").Select
    ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
    Range("B6").Select
    ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=1, Criteria1:="="
    Range("Table2").Select
    Range("A253").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Delete
    ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=1
    Range("Table2[#All]").Select
    Selection.Cut

    Sheets("XT18053").Select
    Range("Q1").Select
    ActiveSheet.Paste

    Sheets("Sheet3").Select
    ActiveWindow.SelectedSheets.Delete

    Sheets("XT18053").Select
    Range("U13").Select
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "FTE Tracking"
    Sheets("XT18053").Select

    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table2").Sort.SortFields. _
            Clear
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table2").Sort.SortFields.Add _
            Key:=Range("Table2[[#All],[Reference Number]]"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("XT18053").ListObjects("Table2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table1").Sort.SortFields. _
            Clear
    ActiveWorkbook.Worksheets("XT18053").ListObjects("Table1").Sort.SortFields.Add _
            Key:=Range("Table1[[#All],[Reference Number]]"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("XT18053").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Upvote 0
Hi Mole, thank you for your help. Your solution appears to have unfortunately not generated the desired result, but I have decided to simply the macro in the interest of delivery. Thanks!
 
Upvote 0
1004 means what ever the code is looking for isn't found

as for what I did, it was to show a way to tidy the code, it made no changes to actions
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Macro VBA Code to delete filtered rows in a list
Replies
1
Views
167
saboh12617
S
G
  • Question Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
832
GardianAngelUK
G
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
436
willow1985
willow1985
P
  • Question Question
Help with Vba Code
Replies
3
Views
528
Coyotex3
C
S
  • Solved
Macro to filter each column for cells that appear empty, clear the contents and move to the next column for entire table
Replies
3
Views
679
sspatriots
S

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top