Chart Edition by access VBA very Slow

Question

I use a Chart to Display Progress of Activity on ms-access 2007 with VBA, I used to work with PivotCharts wich was fast but not really editable. I need to only display the past months and make invisibles points for the rest of the year.

My Chart is display with 2 Series of 300 points (granularity increased), but I only show Data Labels once in a month. I wasn't able to edit point by point with Pivot Chart so I moved to a classic oldStyle Chart.

My problem is that my edit is very slow, I've read about many things about VBA optimization but nothing done the trick I measured 20 seconds for each curve it's not "acceptable" for my hierarchy. I was thinking about multi-threading but it's way too much work for a so small benefit (%4? or %8?)

(FYI Calculation of points and so on is done before the opening of the Form and is doing great)

Here is my code of this Slow Chart Edition :

Dim intPntCount As Integer
Dim intTmp As Integer
Dim oSeries As Object
Dim colSeries As SeriesCollection
Dim oPnt As Object
Dim intCptSeries As Byte
Dim booPreviousZero As Boolean
Dim startDate, endDate As Date
Dim lngWhite, LngBlack As Long

lngWhite = RGB(255, 255, 255)
LngBlack = RGB(0, 0, 0)
linPlanned.BorderColor = RGB(251, 140, 60)
linCompleted.BorderColor = RGB(52, 84, 136)

lblUnit.Left = 1248 'use fctgetabsciisa chProgressFixs.Axes(2).MaximumScale / 80

With Me.chProgressFixs
    startDate = Now
    .BackColor = lngWhite
    intCptSeries = 0
    'colSeries = .SeriesCollection
    For Each oSeries In .SeriesCollection
        intCptSeries = intCptSeries + 1
        Debug.Print "Series" & intCptSeries
        booPreviousZero = True
        intPntCount = 1
        For Each oPnt In oSeries.Points
            oPnt.ApplyDataLabels
            If oPnt.DataLabel.Caption = "0" Then
                oPnt.Border.Weight = 1
                oPnt.DataLabel.Caption = vbNullString
                If booPreviousZero = False Then
                    oPnt.Border.Color = lngWhite
                    booPreviousZero = True
                Else
                    oPnt.Border.Color = LngBlack
                End If
            Else
                booPreviousZero = False
                oPnt.Border.Weight = 4
                oPnt.DataLabel.Font.Size = 14
                Select Case intCptSeries
                    Case 1: oPnt.Border.Color = linPlanned.BorderColor
                    Case 2: oPnt.Border.Color = linCompleted.BorderColor
                End Select

                If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
                    If (intPntCount < oSeries.Points.Count) Then
                        If (intPntCount <> IntLastDispDay - 1) Then
                            oPnt.DataLabel.Caption = vbNullString
                        Else
                            oPnt.DataLabel.Font.Size = 20
                        End If
                     End If
                End If
            End If
            intPntCount = intPntCount + 1
        Next
        Debug.Print DateDiff("s", startDate, Now)
    Next
    Me.TimerInterval = 1
End With 

Thanks all for your help

Answer 1

Maybe you need to avoid screen refresh with:

Application.ScreenUpdating = False

and then

Application.ScreenUpdating = true

when finished. It also be helpful if you use \ insted of / when dividing, if you don't care about working only with integers. Try it.

Answer 2

Maybe you should replace:

If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then

with something like

If (((intPntCount + 30) MOD 30) > 0 ) Then

and measure the time of execution. Another thing about your code is that:

oPnt.DataLabel.Font.Size = 14

...maybe should be inside the if's trying to avoid rewrite the property two times. Try something like:

If (((intPntCount + 30) MOD 30) > 0 ) Then
    If (intPntCount < oSeries.Points.Count) Then
          If (intPntCount <> IntLastDispDay - 1) Then
                oPnt.DataLabel.Caption = vbNullString
                oPnt.DataLabel.Font.Size = 14
          Else
                oPnt.DataLabel.Font.Size = 20
          End If
Else
    oPnt.DataLabel.Font.Size = 14
    End If
Else
oPnt.DataLabel.Font.Size = 14
End If

Even it would be a very very little improvement to precalculate

 (intPntCount + 30)

in a variable after

 intPntCount = intPntCount + 1

...and use something like:

dim intPntCountSum= 0
(...)
    End If
    intPntCount = intPntCount + 1
    intPntCountSum=intPntCount + 30
Next

Finally, if you don't need the debug info, it would be a good thing to delete the lines:

Debug.Print "Series" & intCptSeries

and

Debug.Print DateDiff("s", startDate, Now)

I hope it help.