Progress bar help needed

[1Ronin]

Hello

I have a macro that help me to extract some data from text files and put on a table in Excel.
The macro is working, adapted by me from old one.
Sometimes I have hundreds of txt files and since the macro is not the fastest on my laptop I don't know how many files are processed/remains.
I want to add a progress bar on screen to know how many files are processes/remains from all files.
I try to do it myself, but no success.
See below the code for my macro:

Private Sub Database_generateur()



Application.ScreenUpdating = False




Dim fichier, repert, Fname As String
Dim data2 As Worksheet
Dim indexrow, indexrow2 As Integer
indexrow = Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A")) + 1
indexrow2 = 1
indexrow = indexrow + 1


'declare active document
Set data2 = ActiveWorkbook.Worksheets("data")


' ask filename to load
fichier = Application.GetOpenFilename("All Files (*.*), *.*")
If fichier = "Faux" Then Exit Sub 'test if cancel


'take the name of file to remove to path to have only directory
Fname = Dir(fichier)
repert = Left(fichier, Len(fichier) - Len(Fname))
Fname = Dir(repert)


Do While (Fname <> "") 'read all xls file
        'test column to fill
        Nb1 = ActiveCell.Column
        
        'create file to find
        fichier = repert & Fname


        'open xls file with data
        Workbooks.OpenText Filename:=fichier _
        , Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1)), TrailingMinusNumbers:=True


Set xlbook = Workbooks(Fname)
Set Cell1 = xlbook.ActiveSheet.Range("A" & indexrow2)


Do While Cell1 <> "CODIGO"


Cell1 = xlbook.ActiveSheet.Range("A" & indexrow2)


'Time recording
If Cell1 = "TIEMPO" Then data2.Range("H" & indexrow).Value = xlbook.ActiveSheet.Range("B" & indexrow2).Value


'Data extraction
If Cell1 = "101" Then data2.Range("I" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "901" Then data2.Range("J" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "1" Then data2.Range("K" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "102" Then data2.Range("L" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "902" Then data2.Range("M" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "2" Then data2.Range("N" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "202" Then data2.Range("O" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "3" Then data2.Range("P" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "5" Then data2.Range("Q" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "4" Then data2.Range("R" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "6" Then data2.Range("S" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "19" Then data2.Range("T" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "14" Then data2.Range("U" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "107" Then data2.Range("V" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "115" Then data2.Range("W" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "915" Then data2.Range("X" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "15" Then data2.Range("Y" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "215" Then data2.Range("Z" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "116" Then data2.Range("AA" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "916" Then data2.Range("AB" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "16" Then data2.Range("AC" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "216" Then data2.Range("AD" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "117" Then data2.Range("AE" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "917" Then data2.Range("AF" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "17" Then data2.Range("AG" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "118" Then data2.Range("AH" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "918" Then data2.Range("AI" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "18" Then data2.Range("AJ" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "700" Then data2.Range("AK" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "701" Then data2.Range("AL" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "610" Then data2.Range("AM" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "611" Then data2.Range("AN" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "20" Then data2.Range("AO" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "121" Then data2.Range("AP" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "21" Then data2.Range("AQ" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "415" Then data2.Range("AR" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "416" Then data2.Range("AS" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "417" Then data2.Range("AT" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "418" Then data2.Range("AU" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "860" Then data2.Range("AV" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value
If Cell1 = "861" Then data2.Range("AW" & indexrow).Value = xlbook.ActiveSheet.Range("T" & indexrow2).Value


indexrow2 = indexrow2 + 1




Loop






data2.Range("A" & indexrow).Value = xlbook.ActiveSheet.Range("I1").Value
data2.Range("B" & indexrow).Value = xlbook.ActiveSheet.Range("B1").Value
data2.Range("C" & indexrow).Value = xlbook.ActiveSheet.Range("B3").Value
data2.Range("D" & indexrow).Value = xlbook.ActiveSheet.Range("A5").Value
data2.Range("E" & indexrow).Value = xlbook.ActiveSheet.Range("B5").Value
'data2.Range("AC" & indexrow).Value = xlbook.ActiveSheet.Range("B3").Value


data2.Range("F" & indexrow).Value = xlbook.ActiveSheet.Range("A" & (indexrow2)).Value


If xlbook.ActiveSheet.Range("A" & indexrow2).Value <> "0" Then
data2.Range("G" & indexrow).Value = xlbook.ActiveSheet.Range("B" & (indexrow2)).Value
data2.Range("H" & indexrow).Value = xlbook.ActiveSheet.Range("C" & (indexrow2)).Value
Else
End If




indexrow = indexrow + 1
indexrow2 = 1


Fname = Dir






xlbook.Close










Loop
Application.ScreenUpdating = True




End Sub


Sub ConvertNum()
Range("A1:A10").Select
Selection.NumberFormat = "0.000"
End Sub






Private Sub CommandButton1_Click()


Database_generateur


End Sub

 

[James006]

Hello,

You should know that ' a progress bar ' will just slow everything down ...

Would recommend to insert at the top of your macro

Application.Calculation = xlCalculationManual

and at the end of your macro

Application.Calculation = xlCalculationAutomatic

which should improve your processing time ...

Hope this will help

 

[1Ronin]

Hi James,

I add your recommendation to macro and was faster. Thanks.
Agree on progress bar display on screen.
But, there is any code to add on my macro to show on screen just a simple information as "Files processed / Total files"?
No animation needed, just this info...

Thanks for help.

 

[James006]

Hi,

You can take a look at Ryan Wells ' nice solution :

https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/

HTH

 

[1Ronin]

Nice example James... but I don't know how to adapt the code to my needs
Can somebody help me?

 

[James006]

Hi again,

Have you tried to encapsulate your code within Ryan's macro ...?

 

[1Ronin]

Yes, I try but is not working for me.
Maybe is something wrong here:

Sub StatusBar_Updater()Dim CurrentStatus As Integer
Dim NumberOfBars As Integer
Dim pctDone As Integer
Dim lastrow As Long, i As Long
lastrow = Range("a" & Rows.Count).End(xlUp).Row


'(Step 1) Display your Status Bar
NumberOfBars = 40
Application.StatusBar = "[" & Space(NumberOfBars) & "]"


For i = 1 To lastrow
'(Step 2) Periodically update your Status Bar
    CurrentStatus = Int((i / lastrow) * NumberOfBars)
    pctDone = Round(CurrentStatus / NumberOfBars * 100, 0)
    Application.StatusBar = "[" & String(CurrentStatus, "|") & _
                            Space(NumberOfBars - CurrentStatus) & "]" & _
                            " " & pctDone & "% Complete"
    DoEvents
    '--------------------------------------
    'the rest of your macro goes below here
    
    Application.Run Database_generateur
    
    '--------------------------------------
'(Step 3) Clear the Status Bar when you're done
    If i = lastrow Then Application.StatusBar = ""
Next i
End Sub

Database_generateur is the big macro for first post.

 

[JazzSP8]

Just to add another option for you - When I want to show a macro is making progress I use;

Application.StatusBar = "Doing stuff"

At various points in my code, say when I'm opening a file - The message appears at the bottom left of the Excel window, just helps to know it's not stuck or how long it's been running etc.

You could use it to keep an eye on your filenames like...

        'create file to find
        fichier = repert & Fname
        Application.StatusBar = "Working on: " & fichier

Finish it off with;

Application.StatusBar = ""

To make it go away when your Macro has finished.

 

[1Ronin]

Hi Jazz,

I put 2nd code and is working. Thanks for solution.
But the solution from Ryan Wells is more intuitive for me and helping.

Regards,

 

[1Ronin]

Hi again,


In the end I found a solution for my needs that is working. I have only one issue.
The macro is working like this:
- Browse computer for files to process (first open of folder)
- Calculate the number of files
- Press START to run main macro (second open of folder)

My problem is that I want to avoid second open of folder since is the same.
I need a little help here....

See below the code:

'browse for short files
Private Sub CommandButton6_Click()
Dim Flink, Fname, Fadress As String, count As Integer


Flink = Application.GetOpenFilename("All Files (*.*), *.*")
If Flink = False Then Exit Sub
TextBox1.Value = Flink
'take the name of file to remove to path to have only directory
Fname = Dir(Flink)
Fadress = Left(Flink, Len(Flink) - Len(Fname))
'MsgBox (Fadress)
Fname = Dir(Fadress)




'Dim FolderPath As String, path As String, count As Integer
'FolderPath = "C:\Documents and Settings\Santosh\Desktop" 'Faddress


'path = FolderPath & "\*.xls"   'Flink


'Filename = Dir(path) 'Fname


Do While Fname <> ""
count = count + 1
Fname = Dir()
Loop


'where to show no. of files
Label5.Caption = count
'Range("Q8").Value = count
'MsgBox count & " : files found in folder"


End Sub




'extraction of short results and put in Data sheet
'Private Sub Database_generateur()
Private Sub CommandButton2_Click()


'Time a section of VBA code using the Timer function
Dim secs1 As Single
Dim secs2 As Single


secs1 = Timer()


'tweak to speed up macro
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual




Dim Flink, Fadress, Fname As String
Dim data2 As Worksheet
Dim indexrow, indexrow2 As Integer
indexrow = Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A")) + 1
indexrow2 = 1
indexrow = indexrow + 1


Dim Fcount As Single
Fcount = 0




'declare active document
Set data2 = ActiveWorkbook.Worksheets("data")


'ask filename to load
Flink = Application.GetOpenFilename("All Files (*.*), *.*")
If Flink = "False" Then Exit Sub 'test if cancel


'take the name of file to remove to path to have only directory
Fname = Dir(Flink)
Fadress = Left(Flink, Len(Flink) - Len(Fname))
Fname = Dir(Fadress)


Do While (Fname <> "") 'read all xls file
        
'test column to fill
.........

I put only a part of code since rest is in the first post.

Thank you for help.