Updating PivotTable Source Data via VBA

fecurtis

Board Regular
Joined
Jun 2, 2008
Messages
57
Hello, with some help from this forum, I was able to come up with this code below:

Code:
Sub ImportNewSource()
    Dim Filt As String
    Dim FilterIndex As Integer
    Dim Title As String
    Dim FilePath As Variant
    Dim ThisPivot As PivotTable
    Dim FileName As String
    Dim ShtNum As Integer
    Dim LastRow As Long
    Dim CellAddr As String
    Dim i As Integer
    Dim n As Integer
    Dim UserDirectory As String
    Dim wbMonth As String
    
    Application.ScreenUpdating = False
    
    ShtNum = ActiveWorkbook.Sheets.Count
    
    If ShtNum <> 31 Then
        Beep
        MsgBox "Error:  Too many sheets in workbook, please delete any sheets that you added to this file then try again.", _
        vbCritical = vbOKOnly, "Warning!"
        Exit Sub
    End If
    
    Set ThisPivot = ThisWorkbook.Worksheets(16).PivotTables(1)
    
    Filt = "Excel Files (*.xls), *.xls," & _
           "All Files (*.*),*.*"
    
    FilterIndex = 1
    
    Title = "Select the monthly MBR file you wish you import data from"
    
    FilePath = Application.GetOpenFilename _
        (FileFilter:=Filt, _
        FilterIndex:=FilterIndex, _
        Title:=Title)
        
    If FilePath = False Then
        MsgBox "Cancelled"
        Exit Sub
    Else
        FileName = FileNameOnly(FilePath)
    End If
    
    If WorkbookIsOpen(FileName) Then
        Beep
        MsgBox "MBR file is currently open!  Please close the file and try again.", _
        vbCritical = vbOKOnly, "File is already open!"
        Exit Sub
    End If
    
    Workbooks.Open FilePath, UpdateLinks:=False
    
    If SheetExists("Detail") = False And SheetExists("BOSS Data") = False Then
        ActiveWorkbook.Close SaveChanges:=False
        Beep
        MsgBox "Invalid PivotTable data in worksheet.", _
        vbCritical = vbOKOnly, "Invalid Data"
        Exit Sub
    Else
        Sheets("Detail").Select
        LastRow = Cells.Find(what:="*", _
        SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
    End If
    
    FilePath = WorksheetFunction.Substitute(FilePath, FileName, "")
    
    With Workbooks(FileName).Worksheets("Detail")
        CellAddr = .Range(.Cells(4, 2), .Cells(LastRow - 18, 116)).Address(ReferenceStyle:=xlR1C1)
    End With
    
    With ThisPivot
        .SourceData = "'" & FilePath & "[" & FileName & "]Detail'!" & CellAddr
        .RefreshTable
    End With
    
    Application.CommandBars("PivotTable").Visible = False
    ThisWorkbook.ShowPivotTableFieldList = False
    
    i = 18
    
    Set ThisPivot = ThisWorkbook.Worksheets(i).PivotTables(1)
    
    Do Until i = 20
    With ThisPivot
        .SourceData = "'" & FilePath & "[" & FileName & "]Detail'!" & CellAddr
        .RefreshTable
    End With
    i = i + 1
    Application.CommandBars("PivotTable").Visible = False
    ThisWorkbook.ShowPivotTableFieldList = False
    Loop
    
    i = 21
    
    Do Until i = 30
    With ThisPivot
        .SourceData = "'" & FilePath & "[" & FileName & "]Detail'!" & CellAddr
        .RefreshTable
    End With
    i = i + 1
    Application.CommandBars("PivotTable").Visible = False
    ThisWorkbook.ShowPivotTableFieldList = False
    Loop
    
    Set ThisPivot = Nothing
    
    wbMonth = Workbooks(FileName).Sheets(1).Cells(3, 2).Value
    
    With ThisWorkbook
        .Sheets(16).Name = "Ed V Total " & wbMonth & " Final"
        .Sheets(18).Name = "TSA " & wbMonth & " Final"
        .Sheets(19).Name = "DHS " & wbMonth & " Final"
        .Sheets(16).Cells(2, 1).Value = wbMonth
        .Sheets(18).Cells(2, 1).Value = wbMonth
        .Sheets(19).Cells(2, 1).Value = wbMonth
        .Sheets(28).Cells(2, 2).Value = Left(wbMonth, Len(wbMonth) - 3) & "QBR"
        .Sheets(30).Cells(2, 2).Value = Left(wbMonth, Len(wbMonth) - 3) & "QBR"
    End With
    
    i = 20
    
    Do Until i = 31
        ThisWorkbook.Sheets(i).Cells(2, 1).Value = wbMonth
        i = i + 1
    Loop
    
    Workbooks(FileName).Close False
    
    UserDirectory = SaveinFolder("Select folder where the files are to be saved:")
    If UserDirectory = "" Then
        MsgBox "You have opted not to save the file at this time.  Remember to change the name of the workbook to reflect the latest month.", _
        vbOKOnly, "Unisys Corporation"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    UserDirectory = UserDirectory & Application.PathSeparator
    
    ThisWorkbook.SaveAs FileName:=UserDirectory & "Ed V Partner-Director Results OL - " & wbMonth & ".xls"
    
    Application.ScreenUpdating = True
End Sub

Its purpose is for the user to select a file which is different every month. The macro then goes into that file into the correct sheet, highlights the proper range then sets the source data in the PivotTables in the original file (over 10 PivotTables) to that specific range.

The only problem is that it only updates two of the PivotTables. The PivotTables in sheets 28 and 30. The rest are left the same with no changes. I get no error message while the macro is being run. Any ideas as to why this is happening? Thanks in advance for the help.
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
I changed the way I declared the "ThisPivot" variable. Instead of using ".Worksheets" I used "Sheets". It still only updated the source data of 2 PivotTables, this time they were two different ones.

I'm completely stumped as to why it could be doing this. I dunno if that symptom would help identify the problem.
 
Upvote 0

Forum statistics

Threads
1,214,385
Messages
6,119,210
Members
448,874
Latest member
b1step2far

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