VBA Progress Meter

[hobbiton73]

Hi, I wonder whether someone may be able to help me please.

I'm trying to implement the 'Progress Bar' shown here: http://datapigtechnologies.com/blog/...he-status-bar/ but I'm having a little difficulty in doing so.

This is my code which I've implemented this:

Private Sub btnFetchFiles_Click()
    
    Dim j As Integer
    
        iRow = 20
        fPath = "\\c\s\CAF1\Dragon Mentor Group\Dragon Scripts\Current\April 2015"
        If fPath <> "" Then
    
            ' make StatusBar visible
            Application.DisplayStatusBar = True
            Set FSO = New Scripting.FileSystemObject
            'First Message
            Application.StatusBar = String(5, ChrW(9609)) & " Working..."
            If FSO.FolderExists(fPath) <> False Then
                'Second Message
                Application.StatusBar = String(5, ChrW(9609)) & " Working..."
                Set SourceFolder = FSO.GetFolder(fPath)
                'Third Message
                Application.StatusBar = String(5, ChrW(9609)) & " Working..."
                IsSubFolder = True
                'Fourth Message
                Application.StatusBar = String(5, ChrW(9609)) & " Still Working..."
                Call DeleteRows
                If AllFilesCheckBox.Value = True Then
                'Fifth Message
                Application.StatusBar = String(5, ChrW(9609)) & " Still Working..."
                    Call ListFilesInFolder(SourceFolder, IsSubFolder)
                    Call ResultSorting(xlAscending, "C20")
                    Call FormatCells
                Else
                    Call ListFilesInFolderXtn(SourceFolder, IsSubFolder)
                    Call ResultSorting(xlAscending, "C20")
                    Call FormatCells
                End If
                'Sixth Message
                Application.StatusBar = String(5, ChrW(9609)) & "Still Working..."
                lblFCount.Caption = iRow - 20
                'Seventh Message
                Application.StatusBar = String(5, ChrW(9609)) & "Almost Done..."
            Else
                MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!"
            End If
        Else
            MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & ""
        End If
                'Eigth Message
                Application.StatusBar = String(5, ChrW(9609)) & "All Files Extracted..."
       'Relinquish the StatusBar
        Application.StatusBar = False
    End Sub

The problem I have is that the blue progress bar is shown and hence doesn't move across the Status Bar. In addition, the only message which is shown is "Still Working".

I just wondered whether someone may be able to look at this please and offer some guidance on how I can solve this.

Many thanks and kind regards

Chris

[Kyle123]

You aren't incrementing the first parameter in the String function, all you use is:

String(5, ChrW(9609))

This should be:

String(5, ChrW(9609))
String(10, ChrW(9609))
String(15, ChrW(9609))

I suspect this won't really have the effect you want since it really needs a loop, but got for it

[hobbiton73]

Hi @Kyle123, thank you for taking the time to come back to me with this, but unfortunately all the increase number does is in crease the length of the 'Status Bar' message width rather than implement the individual progress segments.

Many thanks and kind regards

Chris

[Kyle123]

It increases the size of the progress bar, due to the change in 2013 vs earlier Excel versions the segments won't separate. You could do something like:

Application.Statusbar = ChrW(9609) & " " & ChrW(9609) & " " & ChrW(9609)

Though if that would work for you?

[hobbiton73]

Hi @Kyle123, thank you very much for this. I think I'll have to see if I can find another example to work with Excel 2013 because all the code you suggested works, I would have to repeat multiple times for each part of my script which may become a little cumbersome.

Many thanks and kind regards

Chris

[Kyle123]

Can't you just make a little function?

Public Function ProgressBars(HowMany As Long) As String

    Dim bar As String
    Dim x As Long

    If HowMany < 1 Then HowMany = 1
    
    For x = 1 To HowMany
        ProgressBars = ProgressBars & ChrW(9609) & " "
    Next x

End Function

Then:

Application.StatusBar = ProgressBars(4)

[hobbiton73]

Hi, that's a good idea, I'll give this a try.

Kind Regards

Chris