I have an Excel workbook which refreshes data on startup. After the refresh is finished the rows which don't contain data are being hidden. The refresh is started when a worksheet is activated. I've added the same code in a Before_Print function to ensure the data has had enough time to load. The data is coming from a SQL Server database. But these problems have also existed when I was using Access as a backend.
For 9 out of 10 people the code I have written works. For the people from who it doens't work there happens nothing on startup. The entire 'ThisWorkbook' doesn't seem to be working for them. I think it's due to some difference in settings or something. What could be the problem here? These people have macro's enabled
Here the code which triggers when the worksheet is activated:
Private Sub Worksheet_Activate()
ThisWorkbook.RefreshAll
Application.CalculateUntilAsyncQueriesDone
Dim r As Range, c As Range
Application.ScreenUpdating = False
Set r = Range("H99:H142")
For Each c In r
If Len(c) = 0 Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
Application.ScreenUpdating = True
End Sub
The code that tirggers this on startup:
Private Sub RefreshSheet()
Worksheets("-").Activate
Worksheets("DPM").Activate
End Sub
Sub Workbook_Activate()
Application.OnTime Now + TimeValue("00:00:01"), "ThisWorkbook.RefreshSheet"
End Sub
Thanks in advance,
Related
Apologies any incorrect terms, this is the first time I am trying to code a macro. I currently have the following code running:
Private Sub Worksheet_Deactivate()
'Alpha Show / Hide
If Sheets("Project_selection").Range("D4") = Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf Sheets("Project_selection").Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End Sub
which has been cobbled together from other codes and google. It works, but only when I move out of the sheet, which I think is being driven by the first line.
I would actually like it to activate when the Cell D4 in the 'Project_selection' sheet (a separate sheet to the one the code is on) gets changed - does anyone know how I would do that? I have seen references to worksheet_change, but I do not understand how one defines the target/range to get the appropriate reference.
Hope that makes sense and thanks in advance!
If you were to place the following code under the sheet (Project_selection), it would fire that event every time a change has happened in Cell D4:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Project_selection")
If Target.Address = "$D$4" Then
If ws.Range("D4") = ws.Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf ws.Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End If
End Sub
As per the title, looking to wait for formulae dependent on PivotTable to update before proceeding.
The set up (in Excel 2010 workbook):
PivotTable constructed with
One xlDataField (unchanging),
Several xlRowFields (unchanging), and
One xlPageField (for changing via VBA, to increase speed of data retrieval)
Two-dimensional range (columns x rows) populated using formulae (including GetPivotData derived from the above PivotTable)
Processing (via VBA):
The above mentioned xlPageField is changed (expecting the values in
the above mentioned range are updated)
Two-dimensional range “read” into a Variant for further processing via VBA
The process is falling over between the steps 3 and 4. The range values are not updated before being read into a Variant. It could be the PivotTable is not updating, the formulae dependant on the PivotTable are not updating, or both.
Solutions attempted to date (from various StackOverlow threads or external websites):
PivotTables("*name*").PivotCache.BackgroundQuery = False (Getting Excel VBA to wait for external workbook links to refresh before continuing). Results in Run-time error '1004'.
Activeworkbook.RefreshAll
DoEvents (Wait until ActiveWorkbook.RefreshAll finishes - VBA) No impact.
And a mix of:
ThisWorkbook.RefreshAll
DoEvents
PivotTables("*name*").RefreshTable
DoEvents
Application.Calculate
DoEvents
Do Until Application.CalculationState = xlDone
DoEvents
Loop (Wait until Application.Calculate has finished)
Any guidance would be appreciated.
Requested code (truncated)
Dim AllocationRange As Variant
Dim SwitchHistory As PivotTable
Sub Main()
InitialisePublicVariables
'For each member
GetMemberSwitchHistory
Dim Allocations As New Dictionary: Set Allocations = GetDictionary("Allocations")
// further processes
'Next member
End Sub
Private Sub InitialisePublicVariables()
Set SwitchHistory = Sheets("All Switches (clean)").PivotTables("SwitchHistory")
AllocationRange = Range("AllocationRange")
End Sub
Private Sub GetMemberSwitchHistory()
Dim MemberAccountNumber As String: MemberAccountNumber = Range("MemberAccountNumber").Value
SwitchHistory.PivotFields("Member Account Number").CurrentPage = MemberAccountNumber
SwitchHistory.RefreshTable
DoEvents
End Sub
Regards
Shannon
Can you refactor your code so that you can use the PivotTableUpdate event on the Worksheet to operate on the Pivot after it is updated?
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Debug.Print "Pivot table updated - do stuff..."
End Sub
You can also use the PivtoTableChangeSync event (this may be more appropriate as it discerns changes more).
Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Debug.Print "Pivot table change sync..."
End Sub
More information on this event can be found here:- https://msdn.microsoft.com/EN-US/library/office/ff838251.aspx
Here is my issue, I have subs that work when I tested them with the sheet unlocked, but when I locked the sheet to protect certain cells from being selected or deleted/altered, the subs error out. So I need to add a part to my sub that unlocks, runs the main code, then re-locks the sheet.
I am looking for something like this
Sub Example ()
Dim sample as range
set sample as range("A3:Z100")
Application.ScreenUpdating = false
UN-PROTECT CODE
'Existing sub code here
RE-PROTECT CODE
Application.ScreenUpdating = True
End Sub
I am however unaware on what the code to achieve this should look like. I have tried researching and all I found was incomplete code that based on the comments, didn't work all the time. I did find a suggestion to upon error, have an error handler re-protect the sheet, but not sure how to write this either. Any suggestions?
Oh, and the people who will be using this sheet will not have access to the sheet password. I plan to have the module its self password protected and the subs attached to buttons. So placing the Sheet unlock password in the sub would be ok if it is needed.
Posting my original comment as an answer.
If you use the macro recorder and then protect & unprotect sheets, it will show you the code.
EDIT: Added the below.
If you attempt to unprotect a sheet that is not protected you will get an error. I use this function to test if a sheet is protected, store the result in a Boolean variable and then test the variable to see if a) the sheet must be unprotected before writing to it and b) to see if the sheet should be protected at the end of the proc.
Public Function SheetIsProtected(sheetToCheck As Worksheet) As Boolean
SheetIsProtected = sheetToCheck.ProtectContents
End Function
Do you need it to remove passwords? This worked for me
Sub macroProtect1()
Sheet1.Unprotect Password:="abc"
'Enable error-handling routine for any run-time error
On Error GoTo ErrHandler
'this code will run irrespective of an error or Error Handler
Sheet1.Cells(1, 1) = UCase("hello")
'this code will give a run-time error, because of division by zero. The worksheet will remain unprotected in the absence of an Error Handler.
Sheet1.Cells(2, 1) = 5 / 0
'this code will not run, because on encountering the above error, you go directly to the Error Handler
Sheet1.Cells(3, 1) = Application.Max(24, 112, 66, 4)
Sheet1.Protect Password:="abc"
ErrHandler:
Sheet1.Protect Password:="abc"
End Sub
had a similar problem and found this code on the web:
Sub protectAll()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Protect "password", true, true
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Sub Unprotect1()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Unprotect "password"
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Note that it is designed to protect / unprotect all sheets in the workbook, and works fine. Apologies, and respect, to the original author, I can't remember where I found it (But I don't claim it)...
The most common object that is Protected is the Worksheet Object This make it possible to preserve formulas by Locking the cells that contain them.
Sub Demo()
Dim sh As Worksheet
Set sh = ActiveSheet
sh.Unprotect
' DO YOUR THING
sh.Protect
End Sub
Here's my very simple technique for situations that don't require a password (which are most situations that I run into):
Dim IsProtected As Boolean
IsProtected = SomeWkSh.ProtectContents: If IsProtected Then SomeWkSh.Unprotect
'Do stuff on unprotected sheet...
If IsProtected Then SomeWkSh.Protect
You can, of course, simplify the syntax a bit by using a With SomeWkSh statement but if the "Do stuff..." part refers to properties for methods of a larger, spanning With statement object, then doing so will break that functionality.
Note also that the Protect method's Contents parameter defaults to True, so you don't have to explicitly specify that, although you can for clarity.
Before you go for the obvious: Application.DisplayAlerts = False has not solved my problem.
I have written a VBA procedure (initiated in Excel 2010) which loops around an array containing different Excel files. The loop opens the file, refreshes the data, saves and closes the file for each item in the array. I have written an error catch sub routine so I log which excel files have failed to open/refresh/save etc so a user can manually check them.
Some files are quite large and involve a large amount of data moving across the network; sometimes I get a dialog box with: Excel is waiting for another application to complete an OLE action.
I could use Application.DisplayAlerts = False to disable the message but this would presumably disable all alerts so I couldn't catch the errors?
Further I have tested using the line and it doesn't stop the dialog box pop-up. If I press enter it carries on but will likely pop-up again a few minutes later.
Is there a way to stop is message specifically without stopping other alerts?
NB. My process has a control instance of Excel which runs the VBA and opens the workbooks to be refreshed in a separate instance.
Thanks for your help
An extract of my code is below which contains the refresh elements
Sub Refresh_BoardPivots_Standard()
' On Error GoTo Errorhandler
Dim i
Dim errorText As String
Dim x
Dim objXL As Excel.Application
Set objXL = CreateObject("Excel.Application")
GetPivotsToRefresh ' populate array from SQL
For Each i In StandardBoardPiv
DoEvents
'If File_Exists(i) Then
If isFileOpen(i) = True Then
errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1
Else
objXL.Visible = True 'False
objXL.Workbooks.Open FileName:=i
If objXL.ActiveWorkbook.ReadOnly = False Then
BackgroundQuery = False
Application.DisplayAlerts = False
objXL.ActiveWorkbook.RefreshAll
objXL.Application.CalculateFull
objXL.Application.DisplayAlerts = False
objXL.ActiveWorkbook.Save
objXL.Application.DisplayAlerts = True
objXL.Quit
Else
errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1
objXL.Application.DisplayAlerts = False
objXL.Quit
Application.DisplayAlerts = True
End If
End If
' Else
' errorText = i
' Failed(failedIndex) = errorText
' failedIndex = failedIndex + 1
' End If
DoEvents
If Ref = False Then
Exit For
End If
Next i
Exit Sub
'Errorhandler:
'
'errorText = i
'Failed(failedIndex) = errorText
'failedIndex = failedIndex + 1
'Resume Next
End Sub
"Waiting for another application to complete an OLE action" isn't an alert message you can just turn off and forget, sometimes the macro will be able to continue on after, but in my experience if you are getting that error its only a matter of time until the problem crashes/freezes your whole macro so it should definitely be troubleshot and corrected.
I only get that error when I am using additional Microsoft Office Applications (other than the Excel that is running the code) as objects and one of them has an error- the Excel running the code doesn't know that an error occurred in one of the other applications so it waits and waits and waits and eventually you get the "Waiting for another application to complete an OLE action" message...
So to troubleshoot this sort of problem you got to look for the places you use other MSO apps... In your example, you have an additional instance of Excel and you are pulling data from Access, so its most likely one of those two that is causing the problems...
Below is how I would re-write this code, being more careful with where the code interacts with the other MSO apps, explicitly controlling what is happening in them.. The only piece I couldn't really do much is GetPivotsToRefresh because I cant see what exactly youre doing here, but in my code I just assumed it returned an array with a list of the excel files you want to update. See code below:
Sub Refresh_BoardPivots_Standard()
Dim pivotWB As Workbook
Dim fileList() As Variant
Dim fileCounter As Long
Application.DisplayAlerts = False
fileList = GetPivotsToRefresh 'populate array from SQL
For fileCounter = 1 To UBound(fileList, 1)
Set pivotWB = Workbooks.Open(fileList(fileCounter, 1), False, False)
If pivotWB.ReadOnly = False Then
Call refreshPivotTables(pivotWB)
pivotWB.Close (True)
Else
'... Error handler ...
pivotWB.Close (False)
End If
Next
End Sub
Public Sub refreshPivotTables(targetWB As Workbook)
Dim wsCounter As Long
Dim ptCounter As Long
For wsCounter = 1 To targetWB.Sheets.Count
With targetWB.Sheets(wsCounter)
If .PivotTables.Count > 0 Then
For ptCounter = 1 To .PivotTables.Count
.PivotTables(ptCounter).RefreshDataSourceValues
Next
.Calculate
End If
End With
Next
End Sub
So I created my own 'refreshPivotTables' but you could have embedded that into the master sub, I just thought the loops and loop counters might get a little messy at that point...
Hope this helps,
TheSilkCode
How can I make excel continuously calculate a sheet/range in realtime (not 1 calc/sec) and do it in the background?
I want this metric clock to run like a stopwatch....
=IF(LEN(ROUND((HOUR(NOW())*(100/24)),0))=1,"0"&ROUND((HOUR(NOW())*(100/24)),0),ROUND((HOUR(NOW())*(100/24)),0))&":"&IF(LEN(ROUND((MINUTE(NOW())*(100/60)),0))=1,"0"&ROUND((MINUTE(NOW())*(100/60)),0),ROUND((MINUTE(NOW())*(100/60)),0))&":"&IF(LEN(ROUND((SECOND(NOW())*(100/60)),0))=1,"0"&ROUND((SECOND(NOW())*(100/60)),0),ROUND((SECOND(NOW())*(100/60)),0))
I've used the following to produce the effect you are looking for:
Option Explicit
Public TimerRunning As Boolean
Dim CalculationDelay As Integer
Public Sub StartStop_Click()
If (TimerRunning) Then
TimerRunning = False
Else
TimerRunning = True
TimerLoop
End If
End Sub
Private Sub TimerLoop()
Do While TimerRunning
'// tweak this value to change how often the calculation is performed '
If (CalculationDelay > 500) Then
CalculationDelay = 0
Application.Calculate
Else
CalculationDelay = CalculationDelay + 1
End If
DoEvents
Loop
End Sub
StartStop_Click is the macro that I tie to the Start/Stop button for the stopwatch. You can get fancy, and change its name to "Start" or "Stop" depending on the value of TimerRunning, but I kept things simple to illustrate the concept.
The two key things here are:
Application.Calculate
Which forces Excel to calculate the worksheet, and:
DoEvents
Which allows VBA to run in the background (i.e. Excel does not stop responding to user input). This is what allows you to still press the "Stop" Button even though the timer is running.
I think this might fail your "(not 1 calc/sec)" criteria, but I achieved something similar as follows. Assumes your formula is in cell A1 of a worksheet named Sheet1.
In the ThisWorkbook code module:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:01"), "RecalculateRange"
End Sub
... and in a regular code module:
Public Sub RecalculateRange()
Sheet1.Range("A1").Calculate
Application.OnTime Now + TimeValue("00:00:01"), "RecalculateRange"
End Sub