0

Some background, I had a VBA loop creating PPT slides with various filters/views on an Excel pivot table. It was working (after I added DoEvents). I have recently added functionality to create a new PPT file from scratch with multiple sides before they are populated with the data. It's not working anymore.

Two theories: 1) Somehow the memory got bogged down in the new PPT file creation loop and now the data population loop is erroring out. 2) Something about how the default chart is formatted is messed up. If I edit the charts manually, save, and populate, there is no error. However if I create and then automatically try to populate, there's an error.

Due to complexity of the scripts, the loop to create the slides is completely separate from the loop to reopen and populate the slides.

Here's the section that errors out:

'Paste the final temp dataset into PPT

Range("A1000").Activate

tempdata = Range(Selection, Selection.Offset(months, categories - 1)).Value

Set oChart = oPres.Slides(pages(b)).Shapes(metrics(a)).Chart

oChart.ChartData.Activate

Set wb = oChart.ChartData.Workbook
Set ws = wb.Worksheets(1)

ws.Range("A1:Z1000").ClearContents
ws.Range("A1", Range("A1").Offset(months, categories - 1)).Value = tempdata

'Let code catch up

Application.Wait (Now + TimeValue("00:00:02"))
DoEvents

'Redraw the selected dataset of the chart based on the # of categories and rows

oChart.SetSourceData Source:="='Sheet1'!$A$1:" & toChar(categories + 0) & months + 1, PlotBy:=xlColumns

Despite using both Application.Wait and DoEvents, it is still hanging up.

This is purely a timing issue because if I click Debug and continue running the code with no changes, it works fine. I am also using late binding (maybe?) through the Set Object statement and at the end of the loop I always Set oChart = Nothing.

Sometimes it works to write DoEvents multiple times, but as the process has gotten more complex, even this doesn't work. I'm all out of ideas. Any suggestions?

'Let code catch up

DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents

'Redraw the selected dataset of the chart based on the # of categories and rows

oChart.SetSourceData Source:="='Sheet1'!$A$1:" & toChar(categories + 0) & months + 1, PlotBy:=xlColumns
poshlost
  • 1
  • 1

2 Answers2

0

You may try:

  1. Using Sleep, with this line at the top of your module (outside of your function):

    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    Then add this line in place of, or in addition to, DoEvents:

    Sleep 1     ' Pause for 1 ms

    See:

    https://stackoverflow.com/a/3891017/2707864

    See also:

    https://www.myonlinetraininghub.com/pausing-or-delaying-vba-using-wait-sleep-or-a-loop

  2. Using loops with DoEvents:

    Dim PauseTime, Start, Finish, TotalTime
PauseTime = 4 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
    DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.

    See:

    https://www.mrexcel.com/forum/excel-questions/36052-when-how-use-doevents-solved-post166114.html#post166114

    See also:

    https://www.myonlinetraininghub.com/pausing-or-delaying-vba-using-wait-sleep-or-a-loop

  3. Using combinations thereof, which can improve performance of your system depending on the wait time.

    Public Sub WaitSeconds(intSeconds As Integer)
    On Error GoTo PROC_ERR
    Dim datTime As Date
    datTime = DateAdd("s", intSeconds, Now)
    Do
        Sleep 100
        DoEvents
    Loop Until Now >= datTime

    PROC_EXIT:
    Exit Sub

    PROC_ERR:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.WaitSeconds"
    Resume PROC_EXIT
End Sub

    See:

    http://www.fmsinc.com/microsoftaccess/modules/examples/avoiddoevents.asp

sancho.s ReinstateMonicaCellio
  • 14,708
  • 20
  • 93
  • 185
0

@sancho.s, thanks for your help. So it turns out the error had nothing to do with DoEvents. I had been using that as a sloppy fix without understanding its functionality. Given that, none of the three options worked. I spent all day trying various combinations with no success. Instead, I had to brute force close the embedded PPT workbook, set oChart to Nothing, reinstantiate oChart, reopen the workbook, and close it again.

This made the process 2x slower (but no slower than forcing it to wait on a timer??), and it completely eliminated all errors. Apparently it just didn't like pasting the raw data and reselecting the data the first time the workbook was opened. No idea why.

Sub UpdateChart(ByVal a As Integer, ByVal b As Integer, ByVal months As Integer, ByVal categories As Integer, ByRef pages() As Integer, ByRef metrics() As String, ByVal oPres As Object, ByVal legend_flag As Boolean)

Dim tempdata As Variant

'Paste the final temp dataset into PPT

tempdata = Range(Worksheets("calc").Range("A1000"), Worksheets("calc").Range("A1000").Offset(months, categories - 1)).Value

If legend_flag Then

    Set oChart = oPres.Slides(pages(b)).Shapes("legend").Chart

Else

    Set oChart = oPres.Slides(pages(b)).Shapes(metrics(a)).Chart

End If

oChart.ChartData.Activate

Set wb = oChart.ChartData.Workbook
Set ws = wb.Worksheets(1)

ws.Range("A1:Z1000").ClearContents
ws.Range(ws.Range("A1"), ws.Range("A1").Offset(months, categories - 1)).Value = tempdata

'Close workbook

wb.Close

Set oChart = Nothing

If legend_flag Then

    Set oChart = oPres.Slides(pages(b)).Shapes("legend").Chart

Else

    Set oChart = oPres.Slides(pages(b)).Shapes(metrics(a)).Chart

End If

oChart.ChartData.Activate

'Redraw the selected dataset of the chart based on the # of categories and rows

oChart.SetSourceData Source:="='Sheet1'!$A$1:" & toChar(categories + 0) & months + 1, PlotBy:=xlColumns

'Close workbook

oChart.ChartData.Workbook.Close

Set oChart = Nothing

Exit Sub

End Sub

I also put the code snippet in a subroutine and added Exit Sub at the end to hard reset all parameters in an earlier attempt that didn't work. So all objects and parameters have definitely been cleared for good measure.

Does anyone have any ideas why the object definition/open workbook was tripping up like that? And why DoEvents doesn't actually work for this problem?

poshlost
  • 1
  • 1