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

Arkstone

New Member
Joined
Dec 13, 2020
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
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!
 

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,264
Office Version
  1. 365
Platform
  1. Windows
Why not base the progress off the no of sections/sheets/tables etc.?
 

JB2020

Board Regular
Joined
Jul 29, 2020
Messages
75
Office Version
  1. 365
  2. 2016
  3. 2010
Platform
  1. Windows
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

New Member
Joined
Dec 13, 2020
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
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.
VBA Code:
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
 
Last edited by a moderator:

Watch MrExcel Video

Forum statistics

Threads
1,127,256
Messages
5,623,669
Members
415,983
Latest member
MusicMan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top