Error copying Table but not Range Excel VBA

Question

I have a working script that auto-copies specific cells from a Master Sheet to a secondary Sheet. This script works fine if the Master is set as a range but returns an error when converted to a table.

Script:

Option Explicit

Sub FilterAndCopy()
    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    sht2.UsedRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        .Range("A:B, AB:AD, BO:BO").Copy Destination:=sht2.Cells(4, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Range("B:Z").EntireColumn.Hidden = True ' hide columns
        .Range("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

I have tried changing Range to Table throughout the script (see below). But it returns an error on the following line.

Option Explicit

Sub FilterAndCopy()
    Dim rng As Table, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    sht2.UsedTable.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedTable)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        .Table("A:B, AB:AD, BO:BO").Copy Destination:=sht2.Cells(4, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Table("B:Z").EntireColumn.Hidden = True ' hide columns
        .Table("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

.AutoFilter field:=1, Criteria1:="Faults Raised"

The error is: Run-time error '1004': Method 'Autofilter' of object 'Range' failed

A table is a ListObject. Can you be more specific on how you tried to modify this code? Maybe a small snippet of it, as well as the error thrown. — BigBen
– BigBen, Commented Nov 2, 2018 at 0:47
@BigBen, I just swapped everything labelled Range to Table. The error comes at the FilterandCopy line — Chopin
– Chopin, Commented Nov 2, 2018 at 1:10
There is no Table object in the object model - use the ListObject and its properties. — BigBen
– BigBen, Commented Nov 2, 2018 at 1:13
You want to use structured references to a table instead of range references for the same columns? — Mark Fitzgerald
– Mark Fitzgerald, Commented Nov 2, 2018 at 10:41

rohrl77 · Accepted Answer · 2018-11-09 10:37:16Z

5

+50

There is no such thing as a .UsedTable Range. In order to focus only on the table and the data therein you should use the ListObject and the .DataBodyRange property.

This is the basic idea in getting data from a ListObject.

Sub test()

Debug.Print ActiveSheet.ListObjects(1).DataBodyRange.Address

End Sub

Here is your script changed to include the above:

Sub FilterAndCopy()
    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    sht2.ListObjects(1).DataBodyRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.ListObjects(1).DataBodyRange)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        Dim rngToCopy As Range
        Set rngToCopy = Intersect(.SpecialCells(xlCellTypeVisible), sht1.Range("A:B, AB:AD, BO:BO"))
        Debug.Print rngToCopy.Address
        rngToCopy.Copy Destination:=sht2.Cells(4, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Range("B:Z").EntireColumn.Hidden = True ' hide columns
        .Range("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

edited Nov 9, 2018 at 10:37

answered Nov 5, 2018 at 14:10

rohrl77

3,34712 gold badges51 silver badges79 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

rohrl77 Over a year ago

@JPA0888 were you able to adjust your code to make it work based on the example i gave?

Chopin Over a year ago

Thanks @rohrl77, could you include it in the wider script. I'm having trouble putting it all together.

Chopin Over a year ago

I haven't got it going

rohrl77 Over a year ago

I updated your code. There were a few hitches that did make it somewhat more complicated in activating. Try this answer. The thing that makes your code tricky is that you are copying disconected ranges all in one go.

Collectives™ on Stack Overflow

Error copying Table but not Range Excel VBA

1 Answer 1

4 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

4 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related