How to Clear Filters of tables through VBA code

[Pooja]

Hi,
I have an existing VBA code. This code is consolidating data from different excel to a master file. Now the problem I am facing is if the data files if having an filter than macro is not able to copy entire data and I am missing the lines.

So I need an additional VBA code which will clear the filters from the data files if any before copying it to the master file. Kindly help
Below is the code.

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
    Dim strWhereToCopy As String, strStartCellColName As String
    Dim strLinkSheet As String
    Dim sheetname As String
    Dim AutoFilterMode As String
  
    strLinkSheet = "Link"
  
    On Error GoTo ErrH
    Sheets(strLinkSheet).Select
    Range("B2").Select
  
    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Set rTable = Sheets("MasterData").Range("A1").CurrentRegion
    Set rTable = rTable.Resize(rTable.Rows.Count - 1)

    Set rTable = rTable.Offset(1)
    rTable.Clear

    Do While ActiveCell.Value <> ""
  
      
        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
        strWhereToCopy = ActiveCell.Offset(0, 4).Value
        strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)
      
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook
  
      
        Range(strCopyRange).Select
        Selection.Copy
      
        currentWB.Activate
        Sheets(strWhereToCopy).Select
        lastRow = LastRowInOneColumn(strStartCellColName)
        Cells(lastRow + 1, 1).Select
      
        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Sheets(strLinkSheet).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    'activates sheet of specific name

Worksheets("Dashboard Project view").Activate
    Exit Sub
  
ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
    Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
    'Find the last used row in a Column: column A in this example
    '[URL]http://www.rondebruin.nl/last.htm[/URL]
    Dim lastRow As Long
    With ActiveSheet
    lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
    LastRowInOneColumn = lastRow
End Function

Sub Refresh()
' Refresh Macro

    ActiveWorkbook.RefreshAll
End Sub

 

[Debraj]

Hi Pooja,

Just add an extra line.. like below..

.....

Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
Set dataWB = ActiveWorkbook

'-----
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'-----

Range(strCopyRange).Select
Selection.Copy
......

 

[Pooja]

Hi Debraj,

this is working prefect .. thanks