Sub Run_Master()
''Application.ScreenUpdating = False
''Application.Calculation = xlCalculationManual
'''Application.EnableEvents = False
''Application.DisplayAlerts = False
Dim Wb As Workbook, MasterSht As Worksheet, MasterTbl As ListObject, _
RepBook As Workbook, RepSht As Worksheet, ErrorText As String, i As Long
ErrorText = " setting variables "
Set Wb = ThisWorkbook
Set MasterSht = Wb.Worksheets("Master Sheet")
Set MasterTbl = MasterSht.ListObjects("Tbl_Master")
'On Error GoTo ErrorHandler:
With MasterTbl
For i = 1 To MasterTbl.ListRows.Count
ErrorText = " Opening workbook "
Set RepBook = Workbooks.Open(.DataBodyRange(i, 1))
Application.Wait (Now + TimeValue("0:00:15"))
'run report code here
'##################################################################################################
Dim DropSht As Worksheet, ProSht As Worksheet, ArcSht As Worksheet, sht1 As Worksheet, lo As ListObject
ErrorText = " set sheets "
Set ProSht = RepBook.Worksheets("Procedures")
ErrorText = " refresh list objects "
RepBook.Activate
On Error Resume Next
For Each sht1 In RepBook.Worksheets
For Each lo In sht1.ListObjects
lo.QueryTable.Refresh False
DoEvents
Next lo
Next sht1
On Error GoTo 0
Set lo = Nothing
Set sht1 = Nothing
On Error GoTo ErrorHandler:
With ProSht
If UCase(.Range("A1")) = "MONDAY" Then
.Range("H35") = Date - 3
Else
.Range("H35") = Date - 1
End If
End With
'==================================================================================================
'========Update Pivots=============================================================================
Dim Pt As PivotTable, Pt1 As PivotTable
ErrorText = " refresh pivots "
On Error GoTo 0
RepBook.Activate
Dim Pc As PivotCache
RepBook.Activate
For Each Pc In RepBook.PivotCaches
Pc.Refresh
Next Pc
Set Pc = Nothing
On Error GoTo ErrorHandler:
ProSht.Range("F1").Value = Date
'==================================================================================================
'========Update Data Archive=======================================================================
ErrorText = " Data Archive "
RepBook.Activate
Set ArcSht = RepBook.Worksheets("Data Archive")
Dim End_Col As String
RepBook.Activate
If ArcSht.Range("B3").Value = 1 Then
' do nothing as already updated (removed msgbox to keep things running)
Else
With ArcSht
.Activate
DoEvents
.Columns(16).Insert xlToRight, xlFormatFromLeftOrAbove ' Sheets("Data Archive")
.Range("Q2:" & CStr(Sheets("Data Archive").Range("Q2").End(xlToRight).Offset(321, 0).Address)).Copy
.Range("P2").PasteSpecial xlPasteValuesAndNumberFormats 'Sheets("Data Archive")
DoEvents
Application.Wait (Now + TimeValue("0:00:05"))
Application.CutCopyMode = False
End With
Set ArcSht = Nothing
With ProSht
.Range("C5") = VBA.Format(Date, "mm/dd/yyyy")
.Range("D5") = VBA.Format(Now, "HH:MM")
End With
End If
'==================================================================================================
'========Distribute================================================================================
ErrorText = " Distribute "
Application.Calculate
DoEvents
Dim DistroBook As Workbook, sht As Worksheet, SaveName As String, a As Integer
RepBook.Sheets(Array("Summary", "Breakdown")).Copy
Set DistroBook = ActiveWorkbook
DistroBook.Worksheets("Summary").UsedRange.Value = DistroBook.Worksheets("Summary").UsedRange.Value
'disable events while setting properties and saving workbook
'To prevent Pop Ups
Application.EnableEvents = False
On Error Resume Next
'add the two custom properties to classify the document
RepBook.CustomDocumentProperties.Add Name:="Classification", LinkToContent:=False, _
Value:="Confidential", Type:=4
RepBook.CustomDocumentProperties.Add Name:="HeadersandFooters", LinkToContent:=False, _
Value:="None", Type:=4
SaveName = Trim(RepBook.Name)
a = InStr(1, SaveName, "MI")
SaveName = Left(SaveName, a + 1)
Debug.Print SaveName
'Save the workbook
'DistroBook.SaveAs Filename:= 'file path goes here
'On Error GoTo 0
On Error GoTo ErrorHandler:
'Turn events back on
Application.EnableEvents = True
DistroBook.Close False
Set DistroBook = Nothing
RepBook.Activate
With ProSht
.Range("C6") = VBA.Format(Date, "mm/dd/yyyy")
.Range("D6") = VBA.Format(Now, "HH:MM")
End With
RepBook.Close True
Set RepBook = Nothing
.DataBodyRange(i, 3) = Date
Next_i:
MsgBox "Rep " & i & " Complete."
Next i
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
MsgBox "Error!"
With MasterTbl
.DataBodyRange(i, 5) = Err.Number
.DataBodyRange(i, 6) = Err.Description
.DataBodyRange(i, 7) = Err.LastDllError
.DataBodyRange(i, 8) = Err.Source
.DataBodyRange(i, 9) = ErrorText
End With
If Not RepBook Is Nothing Then RepBook.Close False
Set RepBook = Nothing
Err.Clear
Resume Next_i:
End Sub
