CODEWITHSUNDEEP
loopsexcelpathpivot-tablevba
Edward
Edward

Reputation: 21

Loop Through Workbooks in the Same Folder and Do the Same Excel Task for All-VBA

I have more than 50 files needed to create the pivot table and each file has the same exact formort with different contents. So far, I have finished creating the code for the pivot and it works very well when running alone, however, it failed when I tried to run the code for all workbooks in the same folder. I don't know what happened and why it kept showing that no files could be found despite nothing wrong about the pathname. 

Sub DoAllFiles()
Dim Filename, Pathname As String
Dim WB As Workbook

Pathname = "D:\Reports"   
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""

Application.DisplayAlerts = False
Application.ScreenUpdating = False
    Set WB = Workbooks.Open(Pathname & Filename)  'open all files
    PivotX WB
    WB.Close SaveChanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
    Filename = Dir()
Loop
End Sub

Here is the code for pivot and it works very well when running it alone:

Sub PivotX(WB As Workbook)
Dim Lrow, Lcol As Long
Dim wsData As Worksheet
Dim rngRaw As Range
Dim PvtTabCache As PivotCache
Dim PvtTab As PivotTable
Dim wsPvtTab As Worksheet
Dim PvtFld As PivotField

Set wsData = ActiveSheet
Lrow = wsData.Cells(Rows.Count, "B").End(xlUp).Row
Lcol = wsData.Cells(1, Columns.Count).End(xlToLeft).Column
Set rngRaw = wsData.Range(Cells(1, 1), Cells(Lrow, Lcol))
Set wsPvtTab = Worksheets.Add
wsData.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngRaw, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTab.Range("A3"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12

Set PvtTab = wsPvtTab.PivotTables("PivotTable1")

PvtTab.ManualUpdate = True
Set PvtFld = PvtTab.PivotFields("Month")
PvtFld.Orientation = xlPageField
PvtTab.PivotFields("Month").ClearAllFilters

Set PvtFld = PvtTab.PivotFields("Year")
PvtFld.Orientation = xlPageField
PvtTab.PivotFields("Year").ClearAllFilters

Set PvtFld = PvtTab.PivotFields("Fund_Code")
PvtFld.Orientation = xlRowField
PvtFld.Position = 1

Set PvtFld = PvtTab.PivotFields("Curr")
PvtFld.Orientation = xlColumnField
PvtFld.Position = 1
wsPvtTab.PivotTables("PivotTable1").PivotFields("Curr").PivotItems("USD").Position = 1

With PvtTab.PivotFields("Trx_Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0;[red](#,##0)"
End With

wsPvtTab.PivotTables("Pivottable1").RowAxisLayout xlTabularRow

'Remove grand total
wsPvtTab.PivotTables("Pivottable1").RowGrand = False

For Each PvtTbCache In ActiveWorkbook.PivotCaches
    On Error Resume Next
    PvtTbCache.Refresh
Next PvtTbCache

'Determine filter value
Set PvtFld = PvtTab.PivotFields("Year")
PvtFld.ClearAllFilters
PvtFld.EnableMultiplePageItems = True
  With PvtFld
    .AutoSort xlmnual, .SourceName
    For Each Pi In PvtFld.PivotItems
            Select Case Pi.Name
                Case "2014"
                Case Else
                    Pi.Visible = False
            End Select
    Next Pi
    .AutoSort xlAscending, .SourceName
  End With

'determine filter value
Set PvtFld = PvtTab.PivotFields("Month")
PvtFld.ClearAllFilters
PvtFld.EnableMultiplePageItems = True
  With PvtFld
    .AutoSort xlmnual, .SourceName
    For Each Pi In PvtFld.PivotItems
            Select Case Pi.Name
                Case "11"
                Case Else
                    Pi.Visible = False
            End Select
    Next Pi
    .AutoSort xlAscending, .SourceName
  End With
PvtTab.ManualUpdate = False
End Sub

Any help would be very much appreciated. Thank you very much in advance.

Upvotes: 0

Views: 2033

Answers (2)

user4039065
user4039065

Reputation:

I believe you have the answer to your base problem above but I would offer the following 'tweaks' to avoid screen flashing and unrecovered variable assignment.

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Filename <> ""
    Set WB = Workbooks.Open(Pathname & "\" & Filename)  'open all files
    Call PivotX(WB)
    WB.Close SaveChanges:=True
    Set WB = Nothing
    Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True

The Set WB = Nothing is really only purposeful on the last pass when WB is not reassigned but your PivotX sub could use several Set nnn = Nothing before exiting. While the reference count is supposed to be decremented (and memory consequently released), that is not always the case. (see Is there a need to set Objects to Nothing inside VBA Functions) In short, it is just good coding practise.

Finally, using Dim Filename, Pathname As String declares Filename as a variant, not a string type. It isn't making any difference here but you should be aware of what your variables are being declared as.

Upvotes: 2

Kyle Tegt
Kyle Tegt

Reputation: 103

This should solve your problem:

Set WB = Workbooks.Open(Pathname & "\" & Filename)

When I tried using your code, for some reason, it did not retain the backslash you put at the beginning of the "Filename" variable. That would explain why VBA couldn't find the files. Adding it back should between the path name and file name should make it work correctly

Upvotes: 3

Related Questions