Excel VBA Progress Bar with userform - excel

I'm trying to learn how to use a progress bar with a userform.
The problem I have, with my code, is that it displays the progress bar after running the loop; it should be running the loop while showing the progress bar instead like 10%...20%...30%...40%......100%.
Can anyone help me fix my code to achieve this?
'-----Below is loop-----------------------------------------------------
Sub looprange()
Dim r As Range
'----------loop thru 0 to 9 ---------------
For Each r In Sheet6.Range("j2", Range("j" & Rows.Count).End(xlUp))
Sheet6.Range("i2").Value = r.Value
ActiveWindow.ScrollRow = 11
Application.CutCopyMode = False
Call print_jpeg
Next r
MsgBox "done"
End Sub
--
'--------Below is vba code in userform :------------
Private Sub UserForm_Activate()
Dim remainder As Long
Dim i As Long, j As Long
Call looprange
remainder = 0
For i = 1 To 200
UserForm1.Label2.Width = UserForm1.Label2.Width + 1
If i Mod 2 = 0 Then
remainder = remainder + 1
UserForm1.Caption = remainder & ” % complete”
UserForm1.Label2.Caption = remainder & “%”
End If
For j = 1 To 600
DoEvents
Next j
Next i
MsgBox “Loading of program complete.”
Unload UserForm1
End Sub

I believe a true status bar is not included in standard VBA (without references), however you can abuse a label control. Be aware that this method trades performance for user clarity (the user can see that the application is working, but it is slower than the same application without the status bar)
Simply add three labels, one for status text, one for the actual moving bar and one for full bar border. And format them to fit your application (see image below):
Code below:
Private Sub cbStart_Click()
one_percent_bar_width = lLoadBar.Width / 100 'width of one percent of the total loading bar
max_numbers = 1000 'only for demo purpose
Me.lLoadingBar.Visible = True
For i = 0 To max_numbers 'your loop here
'your code here
percentage = i / max_numbers * 100 'calculation of progress, replace i and max_numbers to fit your loop
Me.lStatus.Caption = percentage & "% complete" 'status percentage text
Me.lLoadingBar.Width = percentage * one_percent_bar_width 'width of actual blue bar
DoEvents 'slows down code but only way to make the bar visibly move, tradeoff between user clarity and speed
Next i 'edit to fit your loop
Me.lStatus.Caption = "Complete!" 'adjust status to whatever you want
End Sub
Private Sub UserForm_Initialize()
Me.lLoadingBar.Visible = False 'hide the small blue bar
Me.lStatus.Caption = "Progress not started" 'adjust status to whatever you want
End Sub

There are a few issues with your code, but to focus on the Progress Bar part, I'll share an example of one way to handle a progress bar in Excel (using the built-in status bar).
Instead of actually doing anything useful, this example is pausing for a split second between loops, but reports the status on the status bar.) Hopefully it will give you some ideas.
Sub ProgressBarTest()
Const LoopsToRun = 500
Dim z As Integer
For z = 1 To LoopsToRun
'put a random number in A1
Range("A1") = Int(Rnd() * 100) + 1
'update status bar
Application.StatusBar = "Progress: " & Format((z / LoopsToRun), "0.0%")
'pause for .3 seconds (instead of pausing, you'd run your actual procedure here)
Pause (0.1)
Next z
Application.StatusBar = "Complete!"
End Sub
Sub Pause(sec As Single)
'pauses for [sec] second
Dim startTime As Single
startTime = Timer
Do While Timer < startTime + sec
DoEvents
Loop
End Sub
More info here and here.

VBA has a progress bar control that can be added to forms. While you are learning, you can simply add this control to the form and then update that control during the loop where you are doing the useful form functions. The progress bar controls includes useful properties such as min and max.
If you are doing multiple things in your form, you can update a label to tell the user what is progressing as well as the amount of progress.
[More advanced] In some of my previous work, I have set up VBA routines to run in the background and created a progress bar form using events. This allows for a more sophisticated view with progress statements as well as a percentage run. But the basis of this form is still the progress bar control. While using events is more complicated it allowed me to make a more general progress bar form that can be used by any of my vba functions and these functions are then unaffected by any changes I make to the form because the events act as a kind of standard interface.
Update from a comment by #MathieuGuindon: "The control is actually a VB6 control and will only work in a 32-bit VBA host with the .OCX properly registered, which is getting more and more challenging to do with the more recent Windows versions; referencing and using these controls in VBA7 is heavily discouraged."

Related

How to reduce IF statements for multiple option buttons

I have a UserForm which lets the user input a count of product defects into a textbox. This is done as part of monthly reporting, so I have option buttons to select the Month (12 options). There are also option buttons for selecting Product Type. The code basically evaluates what options are selected and copies the textbox values (defect counts) into specific cells in another spreadsheet (for reporting purposes). Not all TextBoxes are required to have values entered by the User.
You can check out a screenshot of the UserForm https://imgur.com/a/6QefjCp.
As you can see from the code, I'm using a bunch of IF statements to perform the decision making - I would like to reduce the length of this code, but I don't know where to start.
I have never really used VBA prior to this, so haven't really attempted a solution. In its current state, the code works flawlessly. Just looking to reduce and clean-up.
Private Sub OKButton_Click() 'This is the button the user clicks to finalize
'the data entry
'Calling the Product type modules
Call Product1Module
Call Product2Module
Call Product3Module
End Sub
Sub Product1Module() 'All product modules will look almost exactly like this
'except the cell ranges will be different
If UserForm.Product1Button.Value = True Then 'Checking for Product1 Option button
If UserForm.JANButton.Value = True Then
'Record value to textbox if JAN is selected
Sheets("Sheet1").Range("B1107").Value = UserForm.TextBox1.Value
Sheets("Sheet1").Range("B1115").Value = UserForm.TextBox2.Value
Sheets("Sheet1").Range("B1108").Value = UserForm.TextBox3.Value
Sheets("Sheet1").Range("B1116").Value = UserForm.TextBox4.Value
Sheets("Sheet1").Range("B1109").Value = UserForm.TextBox5.Value
Sheets("Sheet1").Range("B1117").Value = UserForm.TextBox6.Value
Sheets("Sheet1").Range("B1111").Value = UserForm.TextBox7.Value
ElseIf UserForm.FEBButton.Value = True Then
Sheets("Sheet1").Range("C1107").Value = UserForm.TextBox1.Value
Sheets("Sheet1").Range("C1115").Value = UserForm.TextBox2.Value
Sheets("Sheet1").Range("C1108").Value = UserForm.TextBox3.Value
Sheets("Sheet1").Range("C1116").Value = UserForm.TextBox4.Value
Sheets("Sheet1").Range("C1109").Value = UserForm.TextBox5.Value
Sheets("Sheet1").Range("C1117").Value = UserForm.TextBox6.Value
Sheets("Sheet1").Range("C1111").Value = UserForm.TextBox7.Value
...
End If
End If
End Sub
Give each of your option buttons a Tag property value - e.g. make JANButton.Tag be "B", then make FeBButton.Tag be "C", etc.
Then you can do this:
Dim targetColumn As String
Select Case True
Case UserForm.JANButton
targetColumn = UserForm.JANButton.Tag
Case UserForm.FEBButton
targetColumn = UserForm.FEBButton.Tag
'...
End Select
With Worksheets("Sheet1") '<~ which workbook is that in? whatever is active?
.Range(targetColumn & "1107").Value = UserForm.TextBox1.Value
.Range(targetColumn & "1115").Value = UserForm.TextBox2.Value
'...
End With

Userform with variable size

In my program a string gets created and its size varies a lot.
This string should then be shown in a separate window.
Unfortunately the regular Msgbox (limited to 1024 signs I believe) is too small for my needs.
Now I created a Userform for the issue but of course it looks silly when there is a giant Userform and only two values inside, but next time I need the size since there are 1000 values in the string.
I noticed that the regular Msgbox changes size depending on how long the string inside it is.
How can I create a userform that changes its size depending on its content?
I only found information on how to make it full screen, which isn't helpful for this case.
The only real code that I can show you is something generic like this:
Sub Ausgabe1()
Dim Werte As Variant
Dim x As Integer
For i = 0 to X
Werte(i) = i
Next i
MsgBox Werte
End Sub
You can vary the value of the width property. How I would do it is to create the userform with a text box and give the userform a displaytext property.
Property Let DisplayText(s as String)
Dim x as Long
x = Len(s)
If x > 0 Then
Me.Textbox1.Width = x*.7
Me.Width = Me.Width * 100/x
Else
Me.Textbox1.Width = 75 ' (edited)
Me.Width = 100
End If
End Property
And then I'd call it like this
Load Userform1
With Userform1
.DisplayText = "your message here"
.Show
End With
You'll have to play with the numbers in the code to get them to fit your screen resolution etcx

Excel Sub very slow at returning control

I have a simple SUB within an Excel VBA module that runs almost instantly and gives control back to the user with no noticeable delay - but only when I run the sub from Excel's Alt-F8 list of public subs.
When I run the same sub by launching it from a button or shape then it still runs almost instantly BUT on finishing takes about 3 seconds to give control back to the user. The Windows busy circle icon displays on the screen during this pause and Excel does not respond to any key presses.
So, why can launchng a sub from a button be so different to launching from Alt-F8?
(I know that the sub itself runs very quickly as I have tested it with a Timer wrapper which confirms that the actual code runs in less than 0.1 seconds)
The code is shown here, but I would've thought this almost irrelevant as the same code is being run but just being launched by different means.
Public Sub RefDel()
IX = ActiveCell.Row: IY = ActiveCell.Column
If Cells(IX, 2) = "R" And (IY = PlnNor Or IY = PlnRef) Then
II = MsgBox("Remove Reference?", 292, Cells(IX, PlnRef))
If II = vbYes Then
ProtOff
NOF = Cells(IX, PlnNor)
Rows(IX & ":" & IX + NRoRef - 1).Delete Shift:=xlUp
Do While Cells(IX, 2) = "R" ' Renumber subsequent rows
Cells(IX, PlnNor) = NOF
NOF = NOF + 1
IX = IX + NRoRef
Loop
Cells(IX - NRoRef, PlnRef).Select
ProtOn
End If
Else
MsgBox "Select a Reference", vbCritical, "Delete Reference"
End If
End Sub

Spinbar / Input Button Visibility

So I've been working on a spreadsheet that I'm going to use as a template for several more spreadsheets and I've gotten most of the template finished but I would like to add a feature involving the spinbar.
Currently I have 100 input buttons displayed and I know that I will not need 100 buttons for all the possible uses of the template, I just included 100 as a max.
I am looking to add a 1 - 100 spinbar so that it will automatically show/hide buttons depending on the number associated with the spinbar.
I should have no issues figuring out how to hide the buttons or show the buttons, but I cannot figure out the proper code to have buttons visible between 1 - 100.
Sub LocNum ()
Dim i As Integer
Dim n As Integer
n = Worksheets(1).Cell
For i = 1 To n
That's about as far as I can get, so if n is equal to 37 it should only have 37 buttons visible.
I'm getting my code from something I typed up previous before I took a break from it for quite awhile, here is the code.
Sub Populate()
Dim t As Integer
Dim i As Integer
Dim a As String
t = ActiveWorkbook.Sheets.Count - 1
i = 0
For i = 2 To t
a = i - 1
If (ActiveSheet.Shapes("" + "btn.index" & i).Visible = True) Then
ActiveSheet.Shapes("" + "btn.index" & i).Select
Selection.OnAction = "" + "Location" & a + ""
Selection.Characters.Text = ActiveWorkbook.Worksheets(i).Name
Else
Exit Sub
End If
Next i
End Sub
Any help would be appreciated.
Not entirely sure your workflow, but this can help you show/hide the buttons either based on the index (I don't recommend) or the name of the button. You just call this Sub providing the number of buttons to show, rest (index/name higher than the number) will be hidden.
I will let you play with the OnAction.
Option Explicit
Sub ShowButtonsUpTo(ByVal ButtonCount As Long)
Dim oButton As Button ' or Object
For Each oButton In Worksheets(1).Buttons
With oButton
' Based on Index (not recommend):
.Visible = (.Index <= ButtonCount)
' Based on Name (button name):
If InStr(1, .Name, "btn.index", vbTextCompare) = 1 Then
.Visible = (CLng(Replace(.Name, "btn.index", "")) <= ButtonCount)
End If
End With
Next oButton
End Sub

How to update a userform that is a progress bar?

I'm trying to update my userform Updating (which is essentially a progress bar).
It doesn't update the first time the userform is called and the second time it only updates the label description and not the width of the bar.
Sub UpdateUpdatingUF(filenum As Integer, filecount As Integer)
Dim filenumdbl As Double
Dim filecountdbl As Double
Dim boxwidth As Integer
Dim barwidth As Integer
Dim boxwidthdbl As Double
filenumdbl = CDbl(filenum)
filecountdbl = CDbl(filecount)
boxwidthdbl = CDbl(boxwidth)
boxwidth = 300
barwidth = CInt(boxwidthdbl * filenumdbl / filecountdbl)
With Updating
.Label3.Caption = "Running file: " & CStr(filenum) & " / " & CStr(filecount)
.ProgressBar.Width = barwidth
End With
End Sub
I'm probably declaring too many variables but I am trying to make sure that that isn't the cause.
I'm testing with the procedure below.
Sub TestUpdate()
Updating.Show
Call UpdateUpdatingUF(3, 7)
DoEvents
Updating.Repaint
End Sub
Replace
Updating.Show
with
Updating.Show vbModeless
Too late but:
boxwidthdbl = CDbl(boxwidth)
boxwidth = 300
those two lines should be in the reverse order :
boxwidth = 300
boxwidthdbl = CDbl(boxwidth)
as you are using a variable that has not been initialised.
The proposed solution is correct if you want to update during another operation (inside a do/while or a for/next loop for instance). vbModeless instructs the program not to wait for the form to be closed. Updating while the form is displayed is made thanks to that and the DoEvents instruction.
If the update is only required once, you should also reverse the updating of the values and the display of the form:
Call UpdateUpdatingUF(3, 7)
Updating.Show
--> this is why you had to test twice to see the results (you displayed the form before updating the values and had to close it to update the values).
Like this, no more need for doevents and repaint.
To be sure to unload the form, if needed for tests purpose, useUnload Updating.

Resources