Excel VBA Code Race Condition Not Fixed by Wait, Sleep, DoEvents, etc - excel

Question

SOLVED! See the code below for the solution!
I have an Excel file containing multiple shape objects next to a series of text. I wrote a script to identify the location of each shape, identify how many cells to the right and down the text extends to, sets that as a range and then imports that into a chart object so I can save it as a .jpg.
The trouble is that between the creation of the chart and the pasting of the string there exists a Race Condition. If I step through the script it works fine, but as soon as I run it I get nothing but blank images.
I've tried Application.ScreenUpdating = True; Application.PrintCommunication = True; and DoEvents
I've also tried Application.Wait, but even having it wait ten seconds doesn't do the trick, when stepping through the code the chart is loaded in less than 2 seconds.
Recently I tried the kernel32 sleep method as well, and that doesn't seem to work either. Again, the amount of time I let the system sleep far exceeded my stepping. I also added all of the above methods between each line within the With statement (obviously not as a solution, but as a test) and that didn't work either..
At this point I'm completely at a loss.
If I place a stop at .Chart.Paste and then run the script (F5), and just keep hitting Run then the script works wonderfully. I just don't want users to have to sit there and hit run 600 times.
There are obvious redundancies written in between the creation of the chart and pasting of the text. This is all in the attempt at getting the code to work properly when run, and once a solution is found most of that code will be removed.
Option Explicit
Public Function ChartCheck() As String
ReCheckChart:
DoEvents
If ActiveWorkbook.ActiveSheet.ChartObjects.Count > 0 Then
GoTo ContinuePaste:
Else
GoTo ReCheckChart:
ContinuePaste:
End If
End Function
Public Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to Save the Images In"
.AllowMultiSelect = False
If .Show -1 Then GoTo NextCode:
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Private Sub DNImageExtraction_Click()
Dim fileName As String
Dim targetWorkbook As Excel.Workbook
Dim targetWorksheet As Excel.Worksheet
Dim saveLocation As Variant
Dim saveName As String
Dim targetShape As Shape
Dim workingRange As Excel.Range
Dim bottomRow As Long
Dim workingRangeWidth As Double
Dim workingRangeHeight As Double
Dim tempChart As ChartObject
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DNImageExtraction.AutoSize = False 'This is necessary to prevent the system I use from altering the font on the button
DNImageExtraction.AutoSize = True
DNImageExtraction.Height = 38.4
DNImageExtraction.Left = 19.2
DNImageExtraction.Width = 133.8
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Please select Excel file...")
Set targetWorkbook = Workbooks.Open(fileName)
Set targetWorksheet = targetWorkbook.ActiveSheet
saveLocation = GetFolder
For Each targetShape In targetWorksheet.Shapes
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Offset(1, 0)
saveName = workingRange.Text
If workingRange.Offset(0, 1).Value "" Then
If workingRange.Offset(1, 1).Value = "" Then
Set workingRange = Nothing
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize(, 2)
Else
bottomRow = workingRange.Offset(0, 1).End(xlDown).Row
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize((bottomRow + 2 - workingRange.Row), 2)
End If
workingRangeWidth = workingRange.Width
workingRangeHeight = workingRange.Height
End If
workingRange.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Set tempChart = targetWorksheet.ChartObjects.Add(0, 0, workingRangeWidth, workingRangeHeight)
Application.ScreenUpdating = True
Application.PrintCommunication = True
DoEvents
Call ChartCheck
tempChart.Chart.Paste
Application.ScreenUpdating = False
tempChart.Chart.Export fileName:=saveLocation & "\DN " & saveName & ".jpg", Filtername:="JPG"
tempChart.Delete
Set tempChart = Nothing
Next
Application.Workbooks(targetWorkbook.Name).Close savechanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Any assistance in either a solution to the Race Condition, or re organizing the script to avoid the Race Condition altogether would be greatly appreciated.
(Code above was updated per suggestions made by Macro Man, and then re-modified once again to add in all previous suggestions on how to fix Race Condition issues after the changes were not effective.)

Answer 1

Consider using Application.OnTime which is good feature. It allows the scheduling of some code to be run at a certain time, most often one adds a few seconds to the current time.
Excel VBA is single-threaded and so there is no real synchronization but there is a message pump to keep order. The great thing about Application.OnTime is that it will not run despite being scheduled until the current graph of code has completed.
Because Application.OnTime uses the message pump as that is a FIFO structure it is possible to interleave the execution of code.
I think this might help here.
You can schedule a "hasItFinished" procedure which checks the existence of the shape/chart objects and if not re-schedules itself.
P.S. Can be a little tricky to debug, refactor as much code as possible outside of the procedure that you will schedule and unit test them separately. Please don't expect the lovely Edit,Debug and Continue flow that you normally get with VBA if you go down this path.

Answer 2

Try getting rid of the error handlers and labels, and working with objects directly instead of searching through workbook/worksheet collections. Also using meaningful variable names and proper indentation will help follow the code easily should you have any issues.
If your code works when stepping through, that usually suggests there is some issue with the use of ActiveWorkbook when workbooks are being opened/closed. Working with workbooks as objects allows us to overcome that problem because no matter if the workbook is active or not, we are always using the same instance of that workbook.
Private Sub DNImageExtraction_Click()
Dim fileName As String
Dim targetWorkbook As Excel.Workbook
Dim targetWorksheet As Excel.Worksheet
Dim saveLocation As Variant
Dim saveName As String
Dim targetShape As Shape
Dim workingRange As Excel.Range
Dim bottomRow As Long
Dim workingRangeWidth As Double
Dim workingRangeHeight As Double
Dim tempChart As ChartObject
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Please select Excel file...")
Set targetWorkbook = Workbooks.Open(fileName)
Set targetWorksheet = targetWorkbook.ActiveSheet
saveLocation = GetFolder
For Each targetShape In targetWorksheet.Shapes
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Offset(1, 0)
saveName = workingRange.Text
If workingRange.Offset(0, 1).value <> "" Then
If workingRange.Offset(1, 1).value = "" Then
Set workingRange = Nothing
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize(, 2)
Else
bottomRow = workingRange.Offset(0, 1).End(xlDown).Row
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize((bottomRow + 2 - workingRange.Row), 2)
End If
workingRangeWidth = workingRange.Width
workingRangeHeight = workingRange.Height
End If
workingRange.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Set tempChart = targetWorksheet.ChartObjects.Add(0, 0, workingRangeWidth, workingRangeHeight)
With tempChart
.Chart.Paste
.Chart.Export FileName:=saveLocation & "\DN " & saveName & ".jpg", Filtername:="JPG"
.Delete
End With
Set tmpChart = Nothing
DoEvents
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub