Dear All

I have put together an indicator to show the user that Excel is still processing the query refresh and has not locked up etc, screen shot below.

Capture.JPG

The animation works fine except that it seriously increases the time taken to for the background query to refresh. I don't mind if it takes a bit longer or even doubles the time. I have posted the code below and I am wondering if there is better way to achieve this or structure the vba to help minimise the time taken.

Option Explicit

Dim flag As String


Sub animateprogress()

Dim sht As Worksheet
Dim cn As WorkbookConnection
Dim lTime As Variant
Dim i As Integer
Dim m1 As Integer
Dim m2 As Integer
Dim m3 As Integer
Dim m4 As Integer
Dim m5 As Integer

Set sht = Sheet2
flag = "run"

For Each cn In ThisWorkbook.Connections
    If cn = "Query - UploadTrial" Then cn.Refresh
Next cn

For i = 0 To 7
    sht.Shapes("progDot" & i).Fill.Transparency = 0
Next i

i = 0

Do While flag = "run"
    i = i + 1
    m1 = i Mod 8
    m2 = (i + 1) Mod 8
    m3 = (i + 2) Mod 8
    m4 = (i + 3) Mod 8
    m5 = (i + 4) Mod 8
        sht.Shapes("progDot" & m1).Fill.Transparency = 1
        sht.Shapes("progDot" & m2).Fill.Transparency = 0.75
        sht.Shapes("progDot" & m3).Fill.Transparency = 0.5
        sht.Shapes("progDot" & m4).Fill.Transparency = 0.25
        sht.Shapes("progDot" & m5).Fill.Transparency = 0
    DoEvents
    lTime = Timer()
        Do While Timer() - lTime < 0.05
        Loop
    DoEvents
Loop

sht.Shapes("progressIndicator").Visible = False

End Sub


Private Sub QueryTable_AfterRefresh(Success As Boolean)

    flag = "stop"

End Sub