Hello chaps,
I'm facing a problem where VBA does not update pivot tables after all the tasks are done. Please see the code below. It should update all the Pivot tables in every single worksheet.
Sub update_data()
Const raw_data_1 As String = "raw_data_1"
Const raw_data_2 As String = "raw_data_2"
Const shUpdate As String = "ORP"
OPTIMISE (True)
ThisWorkbook.Worksheets(raw_data_1).Cells.ClearContents
If Worksheets(shUpdate).FilterMode = True Then
With ThisWorkbook.Worksheets(shUpdate)
.Range("A2:F" & Range("A" & Rows.Count).End(xlDown).Row).ClearContents
.AutoFilter.Sort.SortFields.Clear
.ShowAllData
End With
Else
With ThisWorkbook.Worksheets(shUpdate)
.Range("A2:F" & Range("A" & Rows.Count).End(xlDown).Row).ClearContents
End With
End If
With ThisWorkbook.Worksheets(raw_data_1).QueryTables.Add(Connection:= _
"URL;https://www.link/", Destination _
:=Worksheets(raw_data_1).Range("A1"))
.Name = "packageSummary"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """ec_table"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ThisWorkbook.Worksheets(raw_data_1)
.Range(.Range("A3"), .Range("A3").End(xlDown)).copy _
Destination:=Worksheets(shUpdate).Range("A2")
End With
With ThisWorkbook.Worksheets(shUpdate)
.Range(.Range("A2"), .Range("A2").End(xlDown)).TextToColumns _
Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
End With
With ThisWorkbook.Worksheets(raw_data_1)
.Range("D3:D" & Range("D" & Rows.Count).End(xlDown).Row).copy _
Destination:=Worksheets(shUpdate).Range("D2")
.Range("F3:F" & Range("F" & Rows.Count).End(xlDown).Row).copy _
Destination:=Worksheets(shUpdate).Range("E2")
.Range("G3:G" & Range("G" & Rows.Count).End(xlDown).Row).copy _
Destination:=Worksheets(shUpdate).Range("F2")
End With
ThisWorkbook.Worksheets(raw_data_2).Cells.ClearContents
With ThisWorkbook.Worksheets(raw_data_2).QueryTables.Add(Connection:= _
"URL;https://link/", _
Destination:=Worksheets(raw_data_2).Range("A1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With
For Each Worksheet In ThisWorkbook.Worksheets
For Each PivotTable In Worksheet.PivotTables
PivotTable.RefreshTable
Next PivotTable
Next Worksheet
OPTIMISE False
End Sub
Bookmarks