Create Progress Bar that is based on how long it takes the VBA code to run.

[Arkstone]

Hi,

I have a macro that reads 16 user inputs in cells - 8 sections with a starting number and ending number for each. When the macro is run it input this info a total of 14 worksheets. Each sheet contains 8 tables - one for each section. I want to create a progress bar letting the user know its total percentage, and what sheet it is setting up? All I can seem to find is progress bars that read off rows in sheets. Is there any way of creating a function that analyses how long it will take to run code and then use this info for a progress bar?

Any help greatly appreciated!

 

[Norie]

Why not base the progress off the no of sections/sheets/tables etc.?

 

[JB2020]

I would create a userform with a progress control and a textbox, then update them periodically as your code runs. You could time how long it takes your code to run, then periodically check it against the time elapsed also, though the time it takes to run will vary to some extent.

 

[Arkstone]

Sorry I'm new to VBA so have never attempted progress bars before. Below is part of my code. This is the setup for first Bank. There is 8 of these in total in procedure and only chance is row numbers increase. How would I get progress bar to work in this case? Thanks in advance

tillBank1Last is variable for user entry when workbook is opened.
tillBank1Last2 is the same user entry but only set when this macro is run - this is just for efficiency to make sure macro only updates values that have been change.

x = 1 in this case

' Setup Till Bank 1
        If tillBank1Last2 <> tillBank1Last Then
            For row = 11 To 60 Step 1
                On Error Resume Next
                If x <= tillBank1Last2 Then
                    Worksheets("-Sun Till Rota-").Range("D" & row).Value = ("T" & x)
                    Worksheets("-Mon Till Rota-").Range("D" & row).Value = "T" & x
                    Worksheets("-Tue Till Rota-").Range("D" & row).Value = "T" & x
                    Worksheets("-Wed Till Rota-").Range("D" & row).Value = "T" & x
                    Worksheets("-Thur Till Rota-").Range("D" & row).Value = "T" & x
                    Worksheets("-Fri Till Rota-").Range("D" & row).Value = "T" & x
                    Worksheets("-Sat Till Rota-").Range("D" & row).Value = "T" & x
                    Worksheets("_Sun Till Rota_").Range("D" & row).Value = "T" & x
                    Worksheets("_Mon Till Rota_").Range("D" & row).Value = "T" & x
                    Worksheets("_Tue Till Rota_").Range("D" & row).Value = "T" & x
                    Worksheets("_Wed Till Rota_").Range("D" & row).Value = "T" & x
                    Worksheets("_Thur Till Rota_").Range("D" & row).Value = "T" & x
                    Worksheets("_Fri Till Rota_").Range("D" & row).Value = "T" & x
                    Worksheets("_Sat Till Rota_").Range("D" & row).Value = "T" & x
                Else
                    Worksheets("-Sun Till Rota-").Range("D" & row).Value = ""
                    Worksheets("-Mon Till Rota-").Range("D" & row).Value = ""
                    Worksheets("-Tue Till Rota-").Range("D" & row).Value = ""
                    Worksheets("-Wed Till Rota-").Range("D" & row).Value = ""
                    Worksheets("-Thur Till Rota-").Range("D" & row).Value = ""
                    Worksheets("-Fri Till Rota-").Range("D" & row).Value = ""
                    Worksheets("-Sat Till Rota-").Range("D" & row).Value = ""
                    Worksheets("_Sun Till Rota_").Range("D" & row).Value = ""
                    Worksheets("_Mon Till Rota_").Range("D" & row).Value = ""
                    Worksheets("_Tue Till Rota_").Range("D" & row).Value = ""
                    Worksheets("_Wed Till Rota_").Range("D" & row).Value = ""
                    Worksheets("_Thur Till Rota_").Range("D" & row).Value = ""
                    Worksheets("_Fri Till Rota_").Range("D" & row).Value = ""
                    Worksheets("_Sat Till Rota_").Range("D" & row).Value = ""
                End If
                x = x + 1
            Next row
            tillBank1Last = tillBank1Last2
        End If