Refreshing other Workbooks

Slicemahn

Board Regular
Joined
Jun 10, 2004
Messages
120
Hi Mr. Excel Nation,

I am glad this forum exists when people such as I get stuck. I am currently working on a project that would refresh data on selected reports. The code works fine, but; the reports are not being refreshed.

In some of the test reports, I created PowerQueries that would refresh the date in (mm/dd/yyyy hh:mm:ss AM/PM format).

VBA Code:
Sub Execute_Action_Choice()

Dim rng As Range: Dim wbFile, ErrorTag As String: Dim pc As PivotCache
Dim x&, y&, ReportCount&, ReportError&, ReportSuccess&, UserSelectedReports&
Dim wb, conn, conn2 As Object
Dim TimerStart As Double


TimerStart = Timer   'Start the clock

ReportCount = Range("B2").CurrentRegion.Rows.Count               'Counts entire contents of reports by row
UserSelectedReports = WorksheetFunction.CountA(Columns(13)) - 1  'Counts the number of reports selected by use to perform action

x = 141: y = 0: ReportError = 0: ReportSuccess = 0


Application.ScreenUpdating = False                               'Begin the flicker free movie!

Sheets("Consolidated_Report_Lists").Activate

Do While x <= ReportCount                                        'Loop established for the entire report list
      
            Do While Cells(x, 13).Value <> ""
            
            Set rng = Cells(x, 13)
            rng.Offset(, 2).Value = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
            wbFile = Cells(x, 25).Value
            
            y = y + 1
            
            'Check # 1 - Is the report Checked Out
            If ReportCheckOut(Cells(x, 25)) = False Then
                ErrorTag = "CheckedOut"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
            End If
            
            'Check #2 - Is the report Active?
             If UserRequestFeasible(Cells(x, 13)) = False And rng.Value = "REFRESH" Then
                ErrorTag = "RefreshRequest"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
             End If
            
            'Check #3 = Is this report already active for your Reactivate request?
             If UserRequestFeasible(Cells(x, 13)) = False And rng.Value = "REACTIVATE" Then
                ErrorTag = "ReactivateRequest"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
             End If
            
             'Check #4 - Is your archive request valid?  Is the report in Active status?
              If UserRequestFeasible(Cells(x, 13)) = False And rng.Value = "ARCHIVE" Then
                ErrorTag = "ArchiveRequest"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
              End If
              
                        
              
              Select Case Cells(x, 13).Value
                    
                    Case "REFRESH"
                    
                    Workbooks.CheckOut wbFile
                    Set wb = Workbooks.Open(wbFile)
                    
                    With wb
                        For Each conn In wb.Connections
                            On Error Resume Next
                            conn.OLEDBConnection.EnableRefresh = True
                        Next
                    End With
                    
                    With wb
                        .RefreshAll
                        'wb.Queries.FastCombine = True
                        Application.CalculateUntilAsynQueriesDone
                        Application.DisplayAlerts = False
                    End With
                    
                    With wb
                        For Each pc In wb.PivotCaches
                            On Error Resume Next
                            pc.Refresh
                        Next pc
                    End With
                    
                    With wb
                        For Each conn2 In wb.Connections
                            On Error Resume Next
                            conn2.OLEDBConnection.EnableRefresh = False
                        Next
                    End With
                    
                    wb.CheckIn True, "Automated Refresh"
                    Application.DisplayAlerts = True
                    Report_Successful_Update Cells(x, 13)
                    ReportSuccess = ReportSuccess + 1
                    
                    Case "ARCHIVE", "REACTIVATE"
                    UpdateMeta Cells(x, 25).Value, Cells(x, 13).Value
  
                    Report_Successful_Update Cells(x, 13)
                    ReportSuccess = ReportSuccess + 1
                    
                End Select
            x = x + 1
            Loop
x = x + 1
Loop

Application.ScreenUpdating = True
End Sub

So a user has the choice to either REFRESH, ARCHIVE, or REACTIVATE the reports. Based upon the choice, the code executes; however, for the refreshing aspect, it does not update the report.

I would appreciate any help or discovery of an oversight on my part. Thank you in advance for your help.
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Thank you Everyone for your help! Here's the answer:

VBA Code:
Sub Execute_Action_Choice()

Dim rng As Range: Dim wbFile, ErrorTag As String: Dim pc As PivotCache
Dim x&, y&, ReportCount&, ReportError&, ReportSuccess&, UserSelectedReports&
Dim wb, conn, conn2 As Object
Dim TimerStart As Double


TimerStart = Timer   'Start the clock

ReportCount = Range("B2").CurrentRegion.Rows.Count               'Counts entire contents of reports by row
UserSelectedReports = WorksheetFunction.CountA(Columns(13)) - 1  'Counts the number of reports selected by use to perform action

x = 141: y = 0: ReportError = 0: ReportSuccess = 0


Application.ScreenUpdating = False                               'Begin the flicker free movie!

Sheets("Consolidated_Report_Lists").Activate

Do While x <= ReportCount                                        'Loop established for the entire report list
      
            Do While Cells(x, 13).Value <> ""
            
            Set rng = Cells(x, 13)
            rng.Offset(, 2).Value = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
            wbFile = Cells(x, 25).Value
            
            y = y + 1
            
            'Check # 1 - Is the report Checked Out
            If ReportCheckOut(Cells(x, 25)) = False Then
                ErrorTag = "CheckedOut"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
            End If
            
            'Check #2 - Is the report Active?
             If UserRequestFeasible(Cells(x, 13)) = False And rng.Value = "REFRESH" Then
                ErrorTag = "RefreshRequest"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
             End If
            
            'Check #3 = Is this report already active for your Reactivate request?
             If UserRequestFeasible(Cells(x, 13)) = False And rng.Value = "REACTIVATE" Then
                ErrorTag = "ReactivateRequest"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
             End If
            
             'Check #4 - Is your archive request valid?  Is the report in Active status?
              If UserRequestFeasible(Cells(x, 13)) = False And rng.Value = "ARCHIVE" Then
                ErrorTag = "ArchiveRequest"
                Report_Errors_Update Cells(x, 13), ErrorTag
                Exit Do
              End If
              
                        
              
              Select Case Cells(x, 13).Value
                    
                    Case "REFRESH"
                    
                    Workbooks.CheckOut wbFile
                    Set wb = Workbooks.Open(wbFile)
                    
                    With wb
                        For Each conn In wb.Connections
                            On Error Resume Next
                            conn.OLEDBConnection.EnableRefresh = True
                        Next
                    End With
                    
                    wb.RefreshAll
                    wb.Queries.FastCombine = True
                    wb.Application.CalculateUntilAsynQueriesDone
                    
                    Application.DisplayAlerts = False
                    
                    
                    With wb
                        For Each pc In wb.PivotCaches
                            On Error Resume Next
                            pc.Refresh
                        Next pc
                    End With
                    
                    With wb
                        For Each conn2 In wb.Connections
                            On Error Resume Next
                            conn2.OLEDBConnection.EnableRefresh = False
                        Next
                    End With
                    
                    wb.CheckIn True, "Automated Refresh"
                    Application.DisplayAlerts = True
                    Report_Successful_Update Cells(x, 13)
                    ReportSuccess = ReportSuccess + 1
                    
                    Case "ARCHIVE", "REACTIVATE"
                    UpdateMeta Cells(x, 25).Value, Cells(x, 13).Value
 
                    Report_Successful_Update Cells(x, 13)
                    ReportSuccess = ReportSuccess + 1
                    
                End Select
            x = x + 1
            Loop
x = x + 1
Loop

Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,212,933
Messages
6,110,752
Members
448,295
Latest member
Uzair Tahir Khan

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