I made a macro that combines three reports in to one.
I first find the dynamic name by looking at open workbooks to find a matching name
For Each wk In Workbooks
If Left(wk.Name, 14) = "PayrollSummary" Then
Set wbpay = Workbooks(wk.Name)
End If
If Left(wk.Name, 12) = "PunchedHours" Then
Set wbpun = Workbooks(wk.Name)
End If
Next
And from the start this line worked (ws is the report it's working on).
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,['" & wbpay.Name & "']payrollsummary!$B:$B,1,FALSE),""Fel"")"
Then that line started acting up and this worked:
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,[" & wbpay.Name & "]payrollsummary!$B:$B,1,FALSE),""Fel"")"
Now I have added a third:
On Error Resume Next
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,['" & wbpay.Name & "']payrollsummary!$B:$B,1,FALSE),""Fel"")"
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,[" & wbpay.Name & "]payrollsummary!$B:$B,1,FALSE),""Fel"")"
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,'[" & wbpay.Name & "]payrollsummary'!$B:$B,1,FALSE),""Fel"")"
On Error GoTo 0
Because today only the third line worked.
Here is an example of the formula in the Excel:
The workbook name will always be ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx.
Looking at the image it seems I have accidentally downloaded the file twice (1).
But either way, I still don't see the reason why three different lines of code works randomly (my impression) with different files.
Is there any way to make sure it will always work so that I don't need to find out what will be the correct way next week?
Apologies for posting an "Answer" here but the discussion is running out of space. Let's look at your code in detail.
For Each wk In Workbooks
If Left(wk.Name, 14) = "PayrollSummary" Then
Set wbpay = Workbooks(wk.Name)
End If
If Left(wk.Name, 12) = "PunchedHours" Then
Set wbpun = Workbooks(wk.Name)
End If
Next
It's not clear why a workbook name that starts with "PayrollSummary" should be checked whether it also starts with "PunchedHours". The two are mutually exclusive. When both are found the search should stop and when one of them isn't found the rest of your macro shouldn't be executed. Either of these things could happen with your above code leading to the errors that follow later. The code below wouldn't have the faults just described.
Sub Trial()
Dim WbPay As Workbook
Dim WbPun As Workbook
If GetWorkbook(WbPay, "PayrollSummary") Then
If Not GetWorkbook(WbPun, "PunchedHours") Then Exit Sub
' continue your code here
Debug.Print WbPay.Name
Debug.Print WbPun.Name
End If
End Sub
Private Function GetWorkbook(Wb As Workbook, _
WbName As String) As Boolean
For Each Wb In Workbooks
If InStr(1, Wb.Name, WbName, vbTextCompare) = 1 Then
GetWorkbook = True
Exit For
Next Wb
End Function
Now we know that the rest of the code can't fail because one of the workbooks wasn't found. Both WbPay and WbPun actually exist and are open.
That leads to the question why we need to use a worksheet function to access them. Since all their content is accessible, why not just get it? But you want this:-
=IFERROR(VLOOKUP(A5,['ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx']payrollsummary!$B:$B,1,FALSE),"Fel")
There are three questions attached to this demand.
In which workbook is the formula? Bear in mind that A5 is on the ActiveSheet of that workbook. What will happen if the sheet on which the formula is entered isn't active at that time? I don't know but if Excel would attempt to execute the formula in such a scenario an error must occur - probably an error 1004.
'ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx' should be WbPay.Name. Why not use that definition? It would guarantee that the referenced workbook really exists and is open. We don't know that of 'ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx'. In fact, the name contains a spelling error even here (lifted from your published code).
Why do you wish to return a value from columns(1) of the look-up array? That would be the same value as you have in A5. Not that this would cause an error in itself but it adds to the general confusion.
The verdict, therefore, is that your plan is high in risk and low in precision. The solution must be in reducing the risk and increasing the precision.
Related
I have been working on debugging this code and I am running into an issue where the code runs fine (no errors) but the changes it is supposed to be making aren't happening in the actual sheet.
What the code is supposed to do:
The goal is to be able to check on saving if any cells have been changed. If they have, it locks all cells with non-blank values and protects the sheet to avoid having those cells edited in future instances.
Here is the code itself:
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "Saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
Sheet1.Unprotect "password"
With Sheet1.Range("A1:I20")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
End With
Sheet1.Protect Password:="password", UserInterFaceOnly:=True, DrawingObjects:=False, AllowFiltering:=True
End If
Xit:
End Sub
This is based on a common piece of code found on multiple forums which seems to work for everyone else. This code USED to work and then something broke it. I thought it was the Range being wrong (which I fixed) but that didn't solve the problem.
What I've tried:
Running the separate code lines in the Immediate window - everything runs properly
Stepping through the code with F8 and debug.print to check what is being pulled by .SpecialCells(xlCellTypeBlanks).Address - this pulls the entire input range every time, regardless of what is in the cells but pulls the correct range when run in the Immediate window
Stepping through also produces no errors and shows that every if and with statement is working correctly
Running the code from different locations (Sheet1, Module, ThisWorkbook) including separating into multiple subs across different locations - no change
Running the code on a brand-new test workbook with no other macros - still doesn't work
Different methods for locking the cells such as a loop through all cells in the range instead of using SpecialCells - didn't work
Even the Protect/Unprotect lines are not working which leads me to believe that the code is somehow disconnected from the worksheet itself.
Anyone have any ideas how that is possible? Or how to fix it?
I am a complete novice, this is my first VBA code (necessity is mother of . . . inept coding by novice).
Problem: Why is my code not updating in real-time? Or in any time at all? Can it be fixed? Do I need to somehow put all 16 sheets worth of VBA code into a "module" or do some other trick to fix it?
Background:
I have VBA code "behind" multiple "client" spreadsheets in a workbook. The code allows cell colors to transfer to a master "all clients" spreadsheet. The reason I needed the VBA code was that there was a function (and INDEX function) already in the color-filled cells.
The code was not working properly, so I figured out that the references were wrong and edited one of the sheets' VBA code to ensure I had the references right. They were correct. But even getting those edited references in that one sheet's code to work correctly took a bunch of clicking around and saving and reopening the document.
I then needed to fix the code in all the other sheets, starting with one of them. I can't for the life of me get anything to happen even though I made the correct edit. I should have seen colors change, but nothing happened.
Google search led me to the news that just putting code "behind" spreadsheets often doesn't work. One reference said I should place it in a module. But I have no idea how to do that across all of my 16 client sheets.
I'm also working over Remote Desktop which is probably not helping. I could probably send myself the workbook if needed.
Below is my code (one sheet's worth). The references are different across sheets so that the various client's data (in vertical columns) populates on the correct horizontal rows of the master sheet. Along with that data are the colors that this VBA code is supposed to help render onto the master sheet.
This is the "Glen" spreadsheet's VBA code, Glen's data that needs to be color coded identically on the "WeeklyRatingsAllClients" sheet (ending up in the BD6:CH6 range and BD7:CH7 range) is in the Q4:Q38 range and the U4:U38 range. The other sheets are the exact same except that in the next person's sheet the BD6:CH6 range and BD7:CH7 ranges will update to become BD8:CH8 range and BD9:CH9 and so on sequentially (next client is 10, 11; next is 12, 13 etc.).
If it matters to anyone, I got the original code here and modified it for my needs: https://www.extendoffice.com/documents/excel/4071-excel-link-cell-color-to-another-cell.html
Also, I make a long comment on above page under "Sara" dated 3 months ago that describes more about the code/purpose and shows how I modified the example code for my purpose and it worked--it's just not working now (probably not useful if you already know this stuff well, like I don't).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range
Dim xCRg As Range
Dim xStrAddress As String
xStrAddress = "WeeklyRatingsAllClients!$BD$6:$CH$6"
Set xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("$Q$4:$Q$38")
On Error Resume Next
For xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
Next
xStrAddress = "WeeklyRatingsAllClients!$BD$7:$CH$7"
Set xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("$U$4:$U$38")
On Error Resume Next
For xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
Next
End Sub
Perhaps use the Workbook.SheetSelectionChange event, something like the following. Note that this can definitely be refactored.
Make sure to add this code in the ThisWorkbook module.
Change "Bob", "Fred", "Joe" to the sheet names in question (in order), and add more Cases as needed, always increasing the offsetNum by 2 from the previous Case.
There's a mismatch in the number of cells on the main sheet vs the client sheet. U4:U38 would be 35 cells, but BD6:CH6 is only 31... more an FYI.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim offsetNum As Long
Select Case Sh.Name
Case "Glen"
offsetNum = 0
Case "Bob"
offsetNum = 2
Case "Fred"
offsetNum = 4
Case "Joe"
offsetNum = 6
Case Else
Exit Sub
End Select
Dim allClientsSheet As Worksheet
Set allClientsSheet = Me.Worksheets("WeeklyRatingsAllClients")
Dim mainColorRange As Range
Set mainColorRange = allClientsSheet.Range("BD6:CH6").offset(offsetNum)
Dim sourceColorRange As Range
Set sourceColorRange = Sh.Range("Q4:Q38")
Dim i As Long
For i = 1 To mainColorRange.Rows(1).Cells.Count
mainColorRange.Rows(1).Cells(i).Interior.Color = sourceColorRange.Cells(i).Interior.Color
Next
Set sourceColorRange = Sh.Range("U4:U38")
For i = 1 To mainColorRange.Rows(2).Cells.Count
mainColorRange.Rows(2).Cells(i).Interior.Color = sourceColorRange.Cells(i).Interior.Color
Next
End Sub
I have looked up the question and have seen several solutions addressing things like Select or having protected worksheets, none of which apply to me here.
For various reasons, I can't post the entire code, but I will give a description of what it does and post the exact sub that is giving me issues.
I have a Macro that generates a number of worksheets based on the Month and Year input by the user (so "1" - "31" or "1" - "30" etc). To generate these worksheets, the macro makes copies of a worksheet fittingly named "EXAMPLE". One thing that is copied is a picture (just a rectangle with the word 'Export' on it) that has a macro attached to it.
I recently made what I thought was a cosmetic change by moving the location of this picture, since then, when I run the macro I get an error:
"Run-time error '1004':
Microsoft Excel cannot paste the data."
And options for 'End' 'Debug' and 'Help'
If I select 'Debug' it points me to a second macro which is called during the process of the generation macro'
Sub CopyAllShapes()
Dim ws As Worksheet
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
Sheets("EXAMPLE").Shapes("Picture 1").Copy
ws.Range("J62").PasteSpecial
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
The Debug option highlights the line
ws.Range("J62").PasteSpecial
What really confuses me is that if I select 'End' instead of 'Debug', the macro stops, but all the the sheets have had the picture pasted as well as the Export Macro assigned and everything works as expected. If I were the only person using this, it would be a minor annoyance, but this document is used by many people that can't reliable be told to "just ignore" the error. Since the macro is functioning as expected, how can i troubleshoot what is causing the problem and make the error go away?
As I said, I can't post the entire macro, but I can post some bits and pieces if anyone needs more info.
Not a pure fix, but this code will retry the Copy/Paste if it fails (up to 3 times), instead of just dropping it:
Const MaxRetries AS Long = 3
Sub CopyAllShapes()
Dim ws As Worksheet
Dim TimesRetried As Long
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
TimesRetried = 0
CopyExampleShape:
On Error Resume Next
Sheets("EXAMPLE").Shapes("Picture 1").Copy
ws.Range("J62").PasteSpecial
'If the Copy/Paste fails, retry
If Err Then
On Error GoTo -1 'Clear the Error
'Don't get stuck in an infinite loop
If TimesRetried < MaxRetries Then
'Retry the Copy/paste
TimesRetried = TimesRetried + 1
DoEvents
GoTo CopyExampleShape
End If
End If
On Error GoTo 0
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
I have come across a similar issue before, and it was been down to another program (in one case Skype) reacting to data being added to the Clipboard by "inspecting" it. That then briefly locked the clipboard, so the Paste/PasteSpecial operation failed. This then caused the Clipboard to be wiped clean... All without Excel doing anything wrong.
"It is possible to commit no mistakes and still lose. That is not a weakness; that is life." ~ Jean-Luc Picard
On moving to Office 365 and Win10 (can't say which of those was the culprit) I found a bunch of existing macros which would give that same error when trying to paste a copied image onto a worksheet.
When entering debug, the "paste" line would be highlighted, but if I hit "Continue" it would (after one or two attempts) run with no errors.
I ended up doing this:
'paste problem fix
Sub PastePicRetry(rng As Range)
Dim i As Long
Do While i < 20
On Error Resume Next
rng.PasteSpecial
If Err.Number <> 0 Then
Debug.Print "Paste failed", i
DoEvents
i = i + 1
Else
Exit Do
End If
On Error GoTo 0
i = i + 1
Loop
End Sub
...which looks like overkill but was the only reliable fix for the problem.
EDIT: cleaned up and refactored into a standalone sub.
Just wanted to let everyone know I have found a (sort of) solution. Based on the answers/comments from Tim Williams and PeterT I modified the code to look like this:
Sub CopyAllShapes()
Dim ws As Worksheet
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
Sheets("EXAMPLE").Shapes("Picture 1").Copy
On Error Resume Next
ws.Range("J62").PasteSpecial
On Error Goto 0
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
This has successfully ignored the error and everything is working properly now! Thanks everyone for your help, hopefully this aids someone else in the future!
I am using a macro to copy a sheet (called Copy) from the source (called Book1.xlsm) to copy a sheet to the target workbook (called Book2.xlsb). Before I do the copy, I call a macro in the target (Book2.xlsb) to make certain it's an older version.
Excel crashes or gives an Automation Error Exception Occurred or just a crash when the target workbook is closed (with both saving or not saving).
When I do this from a blank xlsm or xlsb, there is no crash. I use any of 10 real world spreadsheets (from 2MB up to 34MB xlsb), and it happens all the time.
I've spent days trying to make the minimal viable example crash with a smaller spreadsheet as a target with no luck.
The target spreadsheets contain no vba code (just formulas) except for the module that gets imported from the source.
My example has Button1 to make a single copy. 1 field exists for version number (Cell A2).
I am left with the impression that calling code in another workbook is just a bad idea or I'm missing something fundamental. If the call to the target worksheet is not made, everything runs fine.
Main Question: Is running code from another workbook just a bad idea or am I missing something?
Before saving I've tried:
Application.Calculate
Do Until (Application.CalculationState = xlDone) And _
(Application.Workbooks.Count <> 1) And _
(Application.VBE.VBProjects.Count
DoEvents
Loop
TmpTgtWorkbook.Close False
Set TmpTgtWorkbook = Nothing
Before opening, I always make certain only the source workbook is open.
Option Explicit
Function GetVersion(aWorkbook As Workbook) As Double
Dim TmpSheet As Worksheet
GetVersion = 0
On Error Resume Next
Set TmpSheet = aWorkbook.Sheets("Copy")
On Error GoTo 0
If TmpSheet Is Nothing Then
Exit Function
End If
GetVersion = CDbl(TmpSheet.Range("B1"))
End Function
Sub CopyToBook2()
Dim TmpTgtWorkbook As Workbook
Dim TmpSrcVersion As Double
Dim TmpTgtVersion As Double
Const kWorkbookStr = "Book2.xlsb"
TmpSrcVersion = GetVersion(ThisWorkbook)
ThisWorkbook.VBProject.VBComponents("Module1").Export "C:\Temp\Module1"
Set TmpTgtWorkbook = Application.Workbooks.Open(Filename:=ThisWorkbook.Path + "\" + kWorkbookStr)
Err.Clear
On Error Resume Next
'Run the GetVersion Function from the Opened Workbook.
'Removing this line takes away crashes.
TmpTgtVersion = Application.Run(kWorkbookStr + "!GetVersion", TmpTgtWorkbook)
If Err.Number <> 0 Then
Err.Clear
TmpTgtVersion = 0
End If
On Error GoTo 0
If TmpSrcVersion > TmpTgtVersion Then
On Error Resume Next
TmpTgtWorkbook.VBProject.VBComponents.Remove TmpTgtWorkbook.VBProject.VBComponents("Module1")
Application.DisplayAlerts = False
TmpTgtWorkbook.Sheets("Copy").Delete
Application.DisplayAlerts = True
On Error GoTo 0
TmpTgtWorkbook.VBProject.VBComponents.Import "C:\Temp\Module1"
ThisWorkbook.Sheets("Copy").Copy TmpTgtWorkbook.Sheets(1)
TmpTgtWorkbook.ChangeLink ThisWorkbook.Name, TmpTgtWorkbook.Name, xlLinkTypeExcelLinks
TmpTgtWorkbook.Close True
Else
TmpTgtWorkbook.Close False
End If
End Sub
Automation Error Exception Occurred and then a crash or just a crash.
Also, you need to run the code by clicking Button1 2x or more to first copy the module to the target.
I went with Abdes Sabor's workaround. Thanks for that.
Also, considering a small version system for the future which code modules have the CodeModuleName_Major_Minor version format.
My Main Question: Is running code from another workbook just a bad idea or am I missing something?
Unfortunately, all evidence point to Yes. Running a function using Application.Run in another worksheet seems to be bad and potentially corrupts spreadsheets.
Hopefully this is an easy one. I have a series of charts in MS Excel that point to data on the same worksheet. The data on the worksheet is calculated using a VBA function. When the data is updated by the VBA function the new numbers are not reflected in the charts that are pointing to them. I tried calling Application.Calculate, but that didn't do the trick. Any thoughts?
UDPATE:
I was able to duplicate this issue on a much smaller scale. Here's how:
Create a new workbook
Rename Sheet 1 to "Summary"
Rename Sheet 2 to "Data"
Open the Summary sheet in the VBA editor and paste the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Parent.Range("worksheetDate") = Target Then
Application.CalculateFull
End If
End Sub
Create a new VBA module
Paste the following code into the new VBA module (I apologize - I can't get Stack Overflow to format this correctly for the life of me - this is the best I could get it to do):
.
Function getWeekValue (weekNumber As Integer, valuesRange As Range) As Integer
Dim aCell As Range
Dim currentDate As Date
Dim arrayIndex As Integer
Dim weekValues(1 To 6) As Integer
currentDate = ThisWorkbook.Names("worksheetDate").RefersToRange.Value
arrayIndex = 1
For Each aCell In valuesRange
If month(currentDate) = month(ThisWorkbook.Sheets("Data").Cells( _
aCell.Row - 1, aCell.Column)) Then
weekValues(arrayIndex) = aCell.Value
arrayIndex = arrayIndex + 1
End If
Next
getWeekValue = weekValues(weekNumber)
End Function
.
Modify the Data worksheet to match the following image:
Select Cell B1 and name the range "worksheetDate"
Duplicate rows 1 through 3 in the following image:
In row 4, under the "Week X" headers, enter the following formula
.
= getWeekValue(1, Data!$A$2:$M$2)
incrementing the first argument to the getWeekValue function by one for each week (e.g., pass 1 for Week 1, 2 for Week 2, 3, for Week 3, etc.
Create a bar graph using cells A3 through E4 as the data
Change the date in cell B2 to a date between 10/1/2010 and 12/31/2010, choosing a month other than the month that is currently in the cell. For example, if the date is 12/11/2010, change it to something like 11/11/2010 or 10/11/2010. Note that both the data and chart update correctly.
Modify the date in cell B2 gain. Note that the data updates, but the chart does not.
Oddly, after a period of time (several minutes) has elapsed, the chart finally updates. I'm not sure if this is because I have been performing other activities that triggered the update or because Excel is triggering an update after several minutes.
Just figured out the solution to this issue as I was suffering from the same.
I've just added "DoEvents()" prior to printing or exporting and the chart got refreshed.
example
Sub a()
Dim w As Worksheet
Dim a
Set w = Worksheets(1)
For Each a In w.Range("a1:a5")
a.Value = a.Value + 1
Next
DoEvents
End Sub
at the end of my changes I close the workbook and reopen it. that seems the easiest and most reliable way to update everything for me.
For example:
Sub a()
Dim w As Worksheet
Dim a
Set w = Worksheets(1)
For Each a In w.Range("a1:a5")
a.Value = a.Value + 1
Next
w.ChartObjects(1).Chart.Refresh
End Sub
This solution worked for me. For the offending worksheet add:
Private Sub Worksheet_Activate()
Dim rngSelection As Range
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objSeriesCollection As SeriesCollection
Dim objSeries As Series
Dim strFormula As String
Set rngSelection = Selection
For Each objChartObject In Me.ChartObjects
Set objChart = objChartObject.Chart
Set objSeriesCollection = objChart.SeriesCollection
For Each objSeries In objSeriesCollection
strFormula = objSeries.Formula
objSeries.Delete
Set objSeries = objSeriesCollection.NewSeries
objSeries.Formula = strFormula
Next objSeries
Next objChartObject
rngSelection.Select
End Sub
It's possible that the issue is the argument list of getWeekValue, which includes only the week number and the data stream.
If you add a third argument, worksheetDate, then Excel's recalculation engine will be hit on the side of the head with the fact that getWeekValue uses the value held in worksheetDate. In your current implementation, this fact is held only in the VBA code, where it is probably invisible to the recalculation engine.
I write this so hedgingly because I am not privy to the inner workings of the recalculation engine. (Maybe someone who knows about this better than I can comment on my speculation) But I did do a test, in which getWeekValue does have that third argument, and the chart does recalculate properly. Nice added benefit of this approach: you can remove all that other VBA event management. -HTH
I've found that calling this Sub works...
Sub DoAllEvents()
DoEvents
DoEvents
End Sub
BUT
Microsoft cautions about being caught with the next DoEvents executing before the first DoEvents completes, which can happen depending on how often it's called without a delay between calls. Thus DoEvents appears to be acting as a type of non maskable interrupt, and nesting non maskable interrupts can cause the machine to freeze for multiple reasons without any recovery other than reboot.
(Note: If one is not calling the routine above, often and quickly, nesting may not
be an issue.)
Using the following Sub below, which I modified from their suggestion, prevents this from happening.
Sub DoAllEvents()
On Error GoTo ErrorCheck
Dim i
For i = 1 To 4000 ' Start loop. Can be higher, MS sample shows 150000
'I've found twice is enough, but only increased it to four or 4000.
If i Mod 1000 = 0 Then ' If loop has repeated 1000 times.
DoEvents ' Yield to operating system.
End If
Next i
Exit Sub
ErrorCheck:
Debug.Print "Error: "; Error, Err
Resume Next
End Sub
I appears that the number of DoEvents needed is based on the number of background tasks running on your machine, and updating the graph appears to be a background task for the application. I only needed two DoEvents because I call the routine frequently; however, I may end up upping it later if needed.
I also keep the Mod at 1000 so to not change the lag between each DoEvents as Microsoft suggests, preventing nesting. One possible reason you might want to increase the number from 2000 to a higher number is if you system does not update the graph. Increasing this number allows the machine to handle larger numbers of background events that DoEvents might encounter through multiple calls as they are probably on a stack, and the DoEvents event is only allowed to run a specific number of cycles before marking its place in the stack to allow unhandled events and returning, leaving them to be handled on the next call. Thus the need for multiple calls. Changing this to their example of 150000 doesn't appear to slow the machine too much, to play it safe you might want to make it 150000.
Note: the first example Sub with two DoEvents is probably safe depending on how often you call the Sub, however, if called too often, your machine might freeze up. Your call. ;-)
PS: DoEvents will become one of your best calls if you create a lot of nested loops and the program doesn't behave as expected. Fortunately, this is available in all apps that use VBA!
Running Excel 2019.
Added the following to the macro code:
ActiveSheet.ChartObjects(1).Chart.Refresh
DoEvents
The chart now updates during macro execution
UDF getWeekValue has to be marked as volatile.
Function getWeekValue (weekNumber As Integer, valuesRange As Range) As Integer
Application.Volatile '!!
Dim aCell As Range
Dim currentDate As Date
'...
Just an idea: in your Worksheet_Change Sub, insert as the first line:
Application.EnableEvents = False
in order to avoid self-firing events....
Of course set it back to True at the end of the Sub.