vba - copy filtered data to table

[gamerosko]

Hi guys, I try to filter data that I have in Macro file in DataSheet ('DS'). I need to take filtered data only (w/o header row) & copy it into different workbook/sheet 'SFDCReport', where there is a Table (Header row on line 12, 1 data row on 13).

With this code, I received some Error 1004 - sth about Overlapping..

'Filter, Select & Copy filtered data to SFDCReport table
        DS.Range("A1").CurrentRegion.AutoFilter Field:=84, Criteria1:=SubRegion
        Set rTable = DS.AutoFilter.Range
        Set rTable = rTable.Resize(rTable.Rows.Count - 1)
        Set rTable = rTable.Offset(1) 'Move new range down to start at the first data row
        rTable.Copy
        SFDCReport.Cells(13, 1).PasteSpecial xlPasteValues

Then I adjusted based on some advices to this code, but this one keeps copying whole data, not just the selected one..

'Filter, Select & Copy filtered data to SFDCReport table
        DS.Range("A1").CurrentRegion.AutoFilter Field:=84, Criteria1:=SubRegion
        LastRow = DS.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        LastCol = DS.AutoFilter.Range.Columns.Count
        Set rTable = DS.AutoFilter.Range
        Set rTable = rTable.Resize(rTable.Rows.Count - 1)
        Set rTable = rTable.Offset(1) 'Move new range down to start at the first data row
        Set rTable2 = SFDCReport.Range(SFDCReport.Cells(13, 1), SFDCReport.Cells(LastRow, LastCol))
        rTable2.Value = rTable.Value

I am a vba novice, so I copy a lot of stuff from what I find in forums & sometimes it is just hard for me to figure out where the problem is.. Thx for help, Gamca

 

[Fazza]

hi, Gamca

suggest you google/research debugging & try a few things

such as if in the VBE (VB editor) you make the immediate window visible (shortcut within the CTRL-G)

and add to your code after every range assignment line a debug.print of the address. such as
after Set rTable = ...
a new line
debug.print "rTable range is " & rTable.address
and after set rTable2
a new line
debug.print "rTable2 range is " & rTable2.address

now start running the code one line at a time by putting the cursor in the middle of your code and successively pressing F8
look at the immediate window to see the debug.print outputs

also you can ALT-V-S and look at the locals window

Chip Pearson's excellent site has much info, including some on debugging http://www.cpearson.com/excel/DebuggingVBA.aspx

HTH

 

[Fazza]

is this closer to what you want, Gamca?

With DS.Range("A1").CurrentRegion
    .AutoFilter Field:=84, Criteria1:=SubRegion
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy SFDCReport.Cells(13, 1)
End With

 

[gamerosko]

Hello Fazza, thanks for great stuff to study - I will definitely read that through and try to look at debugging & watch windows..

Your code throws the same error 1004 - "Cannot complete operation - Table cannot overlap with a PivotTable report... " at line:

.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy SFDCReport.Cells(13, 1)

Weird is that when I run some other iterations (subregions) code has no problem copying the data into table.. but with this one particular SubRegion that has most rows (smt like 2200) it throws this error.. Anyway I doubt it is about number of rows.. I just can't identify where the problem is.. I thought that I have to resize the destination table first to same number of rows, but still does not explain why only one itteration of the sycle (subregion) is failing with the copy and throwing this error...

 

[Fazza]

what pivot table?

the code I offered was to do some copying to another location
by itself it should be OK apart from if there is a problem applying the filter, or there are no visible cells when the filter is applied. you should handle them as appropriate

if there is a pivot table and you don't know where it is, then loop through all pivot tables and print their addresses

something like, untested. prints to the VBA immediate window

for each wks in worksheets
for each pt in wks.pivottables
debug.print "worksheet " & wks.name & " has pivot table in cells " & pt.tablerange2.address
next pt
next wks

 

[gamerosko]

Thanks Fazza,
solved/corrected whole syntax in the coding to use With/End With according to yours & implemented "address" to all Range Objects & it is working.

So here is just my corrected loop (partial code, without declarations etc..)

For i = 1 To PRFilter
    'Check if Export column is not empty for each SubRegion, if yes, skip to next Subregion(Iteration)
    If IsEmpty(MS.Cells(i + 1, 2).Value) Then
    GoTo NextIteration
        Else 'Things to do if "Not Empty"
        'SubRegion value paste into C10 so Highlights section is updated
        SubRegion = MS.Cells(i + 1, 1).Value
        SFDCReport.Cells(10, 3).Value = SubRegion
        
        'Sheet SFDC Report Cleaning
        With SFDCReport
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastCol = .Cells(12, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(14, 1), .Cells(LastRow, LastCol)).Delete
        End With
                        
        'Filter, Select & Copy filtered data to SFDCReport table
        With DS.Range("A1").CurrentRegion
        .AutoFilter Field:=84, Criteria1:=SubRegion
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy SFDCReport.Cells(13, 1)
        End With
        DealOffice.PivotTables("PivotTable1").RefreshTable 'Refresh PivotTable on DealOffice Sheet
                        
        'Sheet RawData Cleaning
        With RawData
        LastCol = .UsedRange.Columns.Count
        LastRow = .UsedRange.Rows.Count
        .Range(.Cells(2, 1), .Cells(LastRow, LastCol)).Delete
        End With
                
        'Sheet CoverageDealOffice Pivot data copying to RawData
        With DealOffice
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastCol = .Cells(17, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(17, 1), .Cells(LastRow - 1, LastCol)).Copy
        End With
        RawData.Cells(2, 1).PasteSpecial xlPasteValues
        
        'Formatting/other changes & Saving
        SFDCReport.Activate
        ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        ActiveWindow.ScrollColumn = 66
        DealOffice.Activate
        With ActiveWindow.Panes(ActiveWindow.Panes.Count)
        .SmallScroll Up:=Rows.Count, ToLeft:=Columns.Count
        .VisibleRange(1).Select
        End With
        FZ.SaveAs Filename:=DirExport & "\" & "NCE Deal Office Report_" & SubRegion & "_" & CurrDate & ".xlsb", FileFormat:=50
        
NextIteration:
    End If
Next