Sub a_Recalc_Pivot_Table()
' Macro to recalculate Pivot Table.
' 2/7/12 Modified. WML '
' 7/29/19 Copied from "Offfice Development Center". WML
Call Initialize_Globals
Rng = Make_Range(DatLabelRow, 1, -1, -1, DATA) ' "A3:Q972"
Call Recalc_Pivot_Table("Data", Rng, "Pivot Table", 1, 1)
End Sub ' a_Recalc_Pivot_Table
Sub Recalc_Pivot_Table(Sheet_Spec, Rng, Pivot_Sheet_Name, Pivot_Table_Number, Starting_Col_Nr)
' Recalculate a Pivot Table
' 8/6/19 Created. WML
' Note: Assumes data starts in Column 1.
Dim SrcData As String
Dim SHEET As Worksheet
Dim pvtCache As PivotCache
Const Search_Chars = "abcdefghijklmnopqrstuvwxyz"
Prog = "Recalc_Pivot_Table"
Call Sheet_Arg(Sheet_Spec, SHEET, Sheet_Name)
PIVOT.Activate
Call Match_Leading_Chars(Mid_Str(Rng, ":", 1), Search_Chars, Col1, Row1)
Call Match_Leading_Chars(Mid_Str(Rng, ":", 2), Search_Chars, Col2, Row2)
TEMP = "E:\Mac's Data\Mac's Docs on E\Computer\Excel\Spread Sheets" & _
"\Reporting\[Reporting (J).xlsm]Data!R2C1:R1196C17"
Call Text_Before_After(TEMP, ":", Before, TS, 2)
After = "R" & Row2 & "C" & Col_Nr(Col2)
Srsc_Data = Before & ":" & After
Src_Dat_Rt = Right(Srsc_Data, 55)
Pivot_Table_Name = "PivotTable" & Pivot_Table_Number
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Srsc_Data _
, Version:=6)
End Sub ' Recalc_Pivot_Table
Function Match_Leading_Chars(Arg, Pick_From, _
Optional Before, _
Optional After)
' Take the leading consanants off "Arg", _
leave then in "Before", and return the rest in "After".
' 8/6/19 Created. WML
' 8/7/19 Renamed Pick_From "Leading_Consonants" and add arg "Pick_From". WML
' 8/8/19 Added Error Message. WML
' Note: "Pick_From" could be "LETTERS", "NUMBERS", or _
any other set of characters you need to use.
' Note: This may be called either as a Function or a Subroutine.
Prog = "Match_Leading_Chars"
If Len(Arg) Then
Ptr = 0
Before = ""
Do
Ptr = Ptr + 1
Test = Mid(Arg, Ptr, 1)
If InStr(Pick_From, Test) Then
Before = Before & Test
Else
Exit Do
End If
Loop
After = Mid(Arg, Ptr, 99)
Match_Leading_Chars = Before
Else
Msg = "Called with an empty ""Arg""."
Call Msg_Err(Prog, Msg)
Exit Function
End If
End Function ' Match_Leading_Chars()
Function Mid_Str(Text, Seperator, _
Optional First_Occurance = 1, _
Optional Nr_To_Take = 1) As String
' Extract the text "first_Occurance" of the string deliminated by "Sepearator" from "Text".
' 11/10/11 Added Nr_to_Take. WML
' 8/8/19 Made "First_Occurance" optional. WML
TrKnt = 0
Mid_Str = ""
Prog = "Mid_Str"
Dim HOLD() As Variant
HOLD = Split_It(Text, Seperator)
Mid_Str = Split_s(HOLD, First_Occurance, Nr_To_Take, Seperator)
Exit Function
If First_Occurance > 0 Then
' Find Start of Mid_Str in Argument
For Skip = 1 To First_Occurance
Ptr = EndPtr + SepLength
Test = InStr(Ptr, Argument, Seperator)
If Test > 0 Then
' Found Seperator
EndPtr = Test
Else
' Not Found.
Exit Function
End If
Next Skip
Else
' Start with NR'th arguent from last argument.
Ptr = Len(Argument)
End If
' Build Output String
For Arg = 1 To Nr_To_Take
Next_Ptr = InStr(Ptr, Argument, Seperator)
If Len(Mid_Str) Then Mid_Str = Mid_Str & Seperator
If Next_Ptr Then
Mid_Str = Mid_Str & Mid(Argument, Ptr, Next_Ptr - Ptr)
Else
Mid_Str = Mid_Str & Mid(Argument, Ptr, 999)
Exit Function
End If
Ptr = SepLength + Next_Ptr
Next Arg
End Function ' Mid_Str
Function Split_s(Args As Variant, Start_Where, _
How_Many_Arguments, Optional Seperator = "") As String
' Return a string of NR pieces of ARGS.
' If Start_Start_Where is negative, it starts from the back.
' If How_Many_Arguments is negative, it leaves NR of the arguments off.
' Note: ARGS was prepaired by 'Split_It".
' Note: ARGS(0) contains the MaxNrimum number of arguments.
' Added Seperator as Calling Arg.
' 11/19/09 WML
Const Prog = "Split_s"
MaxNr = Args(0)
IMax = How_Many_Arguments
If Seperator = "" Then
Seperator = Args(Args(0) + 2)
End If
' Adjust Calc Specs.
If Start_Where > 0 Then
IStart = Start_Where
Else
IStart = MaxNr - Start_Where
End If
IMax = IStart + IMax - 1
If IMax > MaxNr Then
IMax = MaxNr
End If
Split_s = ""
For I = IStart To IMax
If Len(Split_s) > 0 Then Split_s = Split_s & Seperator
Split_s = Split_s & Args(I)
Next I
End Function ' Split_s
