how to set answer = to command button

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
how do i get this code to wait for a command button click first?
VBA Code:
Sub ProcessnaTEST()
'Dim answer As NightAuditP.Button1.Caption
'answer = buttonText

Call intprogress

NightAuditP.Question.Caption = ("Are you ready to start the night audit file process?" & vbNewLine _
& "This is for the date of: " & Format(Date - 1, "mm-dd-yyyy"))
 
  If answer = Yes Then
'  Call PNT2
  MsgBox "Nihgt Audit Checklist printed"
  'Call pmtpause
  'Call Makefolder
  'Call FolderPicker
   ' Call Msgbox_1A
  ElseIf answer = vbNo Then
    MsgBox "Click Start prior to running audit in Opera when ready.", , "Night Audit Processing"
  Else
    'Call Reset
  End If
  End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
It is not entirely clear to me whether you are using a Userform, as there are more controls that have the Caption property.
Best way imo is to split macro procedures to create a "break". The first macro to finally provide your command button on screen, the second macro in de Click event procedure of that particular command button.
 
Upvote 0
sorry it is related to a user form I have taken your advice and tried my best to split stuff up as best as i could. now the information and buttons displayed are based on an integer set when a button is clicked.
This code displays the userform and sets it up
VBA Code:
Sub intprogress()
Dim s As Integer
With NightAuditP
If s = 0 Then
NightAuditP.Previous.Visible = False
End If
    .Bar.Width = 0
    .TextP.Caption = "0% Complete"
    .Show vbModeless
End With
Call ProcessnaTEST
End Sub
This code displays the prompt and button text depending on the value of "S"
Code:
Sub ProcessnaTEST()
Dim s As Integer
Dim Prompt As String
s = VBAProject.NightAuditP.s

Select Case s
Case Is = 0
        Prompt = NightAuditP.ShowMsg("Are you ready to start the night audit file process?" & vbNewLine _
        & "This is for the date of: " & Format(Date - 1, "mm-dd-yyyy"), NightAuditP.Previous.Visible = False, Button2Text:="Yes")
Case Is = 1
        Prompt = NightAuditP.ShowMsg("Have you saved the" & vbNewLine & "Adjustment Log" & vbNewLine _
        & " & " & vbNewLine & "Daily Cash Log?", , Button1Text = "Back", Button2Text = "Next")
Case Is = 2
        Prompt = NightAuditP.ShowMsg("Please save all required documents to complete final packet." & vbNewLine _
        & "Click OK once completed.", , Button1Text = "back", Button2Text = "next")
Case Is = 3
        Prompt = NightAuditP.ShowMsg("The process will now get all related files." & vbNewLine & _
        "If the process is stopped here nothing will be changed." _
        & vbNewLine & "Do You Wish To Continue?", , Button1Text = "Back", Button2Text = "Next")

End Select
End Sub
My buttons are setup in a similar manner so the button dose something based on the "S" value as well
 
Upvote 0
If I understand correctly, you want some interaction between two different userforms. To start with a general remark, I do not prefer to directly address the VBAProject and there is no need for it at all. VBA offers among others the possibility to pass arguments to procedures when they are called. In this way, procedures can "talk" to each other and exchange data.
Is there a specific need to have one of the userforms modeless on screen? After all, a modal userform keeps waiting for the user to click on something and if I'm right that's what you're after. As I understand from your code there is a need for a progress bar or other kind of dynamic changing user information while a specific task is running. From VBA perspective there is no necessity for a modeless userform to achieve this.
If you're able to give some more explanation on what you ultimately are trying to achieve and willing to provide the rest of your code then we can see which approach is best.
 
Upvote 0
My apologies for the confusion. I will do my best to explain everything as clear as possible. To start I have an "installation wizard" of sorts that used the standard VBboxes to walk a user through several steps to complete multiple tasks . This got the job done but there have been multiple times where something was forgot prior and with VBboses it locks excel. In short the files that needed changed are partly in excel. So the decision was made to move to a userform process instead in the modeless format. This will allow excel to still function but still allow the users to change what they need to and complete all tasks without having to restart the process all over.
I forgot to mention this is only one userform that gets reworked based on the "S"value
also when I tried to reference the "S" with out the full name the values would fall out of sync and it was the same way with the values for the progress bar stuff
This macro starts the userform and sets up the basics for initial display
VBA Code:
Sub intprogress()
Dim s As Integer
With NightAuditP
If s = 0 Then
NightAuditP.Previous.Visible = False
End If
    .Bar.Width = 0
    .TextP.Caption = "0% Complete"
    .Show vbModeless
End With
Call ProcessnaTEST
End Sub
In the macro im setting up everything to the starting point and it only gets run once.
The following macro is the one that displays the label text, button text and updates the progress par. The progress bar was picked as it has become hard to count each step and is a nice way for users to see how much further they have.
Code:
Sub ProcessnaTEST()
Dim s As Integer
Dim Prompt As String
s = VBAProject.NightAuditP.s
Currentprogress = VBAProject.NightAuditP.Currentprogress
Progressprocentage = VBAProject.NightAuditP.Progressprocentage
Barwidth = VBAProject.NightAuditP.Barwidth
Select Case s
Case Is = 0
        Prompt = NightAuditP.ShowMsg("Are you ready to start the night audit file process?" & vbNewLine _
        & "This is for the date of: " & Format(Date - 1, "mm-dd-yyyy"), , (NightAuditP.Previous.Visible = False), Button2Text:="Start")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 1
        Prompt = NightAuditP.ShowMsg("Please Run End Of Day in Opera now." & vbNewLine & "Click OK AFTER Opera is completed.", , Button1Text:="Back", Button2Text:="Next")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 2
        Prompt = NightAuditP.ShowMsg("Have you saved the" & vbNewLine & "Adjustment Log" & vbNewLine _
        & " & " & vbNewLine & "Daily Cash Log?", , Button1Text:="Back", Button2Text:="Next")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 3
        Prompt = NightAuditP.ShowMsg("Please save all required documents to complete final packet." & vbNewLine _
        & "Click OK once completed.", , Button1Text:="back", Button2Text:="next")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 4
        Prompt = NightAuditP.ShowMsg("The process will now get all related files." & vbNewLine & _
        "If the process is stopped here nothing will be changed." _
        & vbNewLine & "Do You Wish To Continue?", , Button1Text:="Back", Button2Text:="Next")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 5
        Prompt = NightAuditP.ShowMsg("All files will now be renamed." & vbNewLine _
        & "This process can not be undone!" & vbNewLine & "Do You Wish To Continue?", , Button1Text:="Back", Button2Text:="Next")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 6
        Prompt = NightAuditP.ShowMsg("Have you made and saved all the notes on these files? :" & vbNewLine _
        & "Credit Card History.pdf" & vbNewLine & "Guest Ledger Detail.pdf" & vbNewLine & "Paid Out.pdf" _
        & vbNewLine & "Rate Variance.pdf", , Button1Text:="Back", Button2Text:="Next")

        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 7
        Prompt = NightAuditP.ShowMsg("The process will now create a temperary file." & vbNewLine _
        & "This file is used for the final step.", , Button1Text:="Back", Button2Text:="Next")
       
        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
Case Is = 8
        Prompt = NightAuditP.ShowMsg("The final packet will be created and saved." & vbNewLine _
        & "This process can not be undone!" & vbNewLine & "Do You Wish To Continue?", , Button1Text:="Back", Button2Text:="Next")

        NightAuditP.Bar.Width = VBAProject.NightAuditP.Barwidth
        NightAuditP.TextP.Caption = VBAProject.NightAuditP.Progressprocentage & "% Complete"
End Select
End Sub
the "S" value is referenced like that because the value is changed by the buttons. and the "S" determines what is displayed and what actions happen when a button is clicked.
the next code is in the userform and i will do my best to shorten it so you get the idea.
Code:
Option Explicit
Public s As Integer ''''This is a publicly declared Integer i.e the value of s can be called upon elsewhere
Const Remaining = 9
Public Currentprogress As Double
Public Progressprocentage As Double
Public Barwidth As Long

Private Sub Previous_Click() 'this will be used to go back and reset "S" to the new value to show the correct things. and in the future undo what was done previously
    Me.Tag = Previous.Caption
Select Case s
    Case Is = 1
         Action = ""
        s = s - 1
        Call ProcessnaTEST
    Case Is = 2
        Action = ""
        s = s - 1
        Call ProcessnaTEST
    Case Is = 3
        Action = ""
        s = s - 1
        Call ProcessnaTEST
    Case Is = 4
        Action = ""       
        s = s - 1
        Call ProcessnaTEST
    Case Is = 5
         Action = ""       
        s = s - 1
        Call ProcessnaTEST
End Select
End Sub

Private Sub Succeeding_Click() 'this section runs the macro that needs to be completed in the correct order and resets the value of "S" and the calls the second macro to display the right information and restarts the process again like a loop
    Me.Tag = Succeeding.Caption
Select Case s
    Case Is = 0
         NightAuditP.Previous.Visible = False
        Action = "Night Audit Checklist printed."
        Call PNT2
        Action = "New folder being generated if not already made."
'Action: this displays what is currently happening and i can update that in each macro to show while that macro is running
        Call Makefolder
        Action = "Selecting foloder location"
        ''Call FolderPicker
        s = s + 1
        Call ProcessnaTEST   
    Case Is = 1
         Action = ""
        s = s + 1
        Call ProcessnaTEST
    Case Is = 2
        Action = ""
        s = s + 1
        Call ProcessnaTEST
    Case Is = 3
        Action = ""
        s = s + 1
        Call ProcessnaTEST
    Case Is = 4
        Action = ""       
        s = s + 1
        Call ProcessnaTEST
End Select
End Sub

Private Sub Help_Click() 'this is just used to give more information of what to do or where to go to complete what is asked. then it just resets so a new button can be clicked again
Me.Tag = Help.Caption
Select Case s
    Case Is = 0
        MsgBox ("We are testing help")       
        Call ProcessnaTEST
    Case Is = 1
        MsgBox ("We are testing help for the second time")         
        Call ProcessnaTEST
    Case Is = 2
         MsgBox ("We are testing help for the last time") 
         Call ProcessnaTEST
End Select
End Sub

Private Sub Cancel_Click()'this will just close the form
     Unload NightAuditP
End Sub

Function ShowMsg(Prompt As String, Optional Title As String, _
    Optional Button1Text As String, Optional Button2Text As String, Optional Button3Text As String) As String

    With NightAuditP
        '.Caption = Title
        .Question.Caption = Prompt
        .Previous.Caption = Button1Text
        .Succeeding.Caption = Button2Text
       ' .CommandButton3.Caption = Button3Text
        .Previous.Visible = (.Previous.Caption <> vbNullString)
        .Succeeding.Visible = (.Succeeding.Caption <> vbNullString)
       ' .CommandButton3.Visible = (.CommandButton3.Caption <> vbNullString)
        '.Button1.Default = True
        If s < 1 Then
        NightAuditP.Previous.Visible = False
        NightAuditP.Repair.Visible = True

        .Bar.Width = 0
        .TextP.Caption = "0% Complete"
        ElseIf s > 0 Then
        NightAuditP.Repair.Visible = False
        '.Show vbModeless
End If
       ' .Show
    End With   
Currentprogress = s / Remaining
Barwidth = NightAuditP.Border.Width * Currentprogress
Progressprocentage = Round(Currentprogress * 100, 0)

End Function
The portion of code just above what is run every time "Call ProcessnaTEST" is run and it allows all my buttons and labels to change text in an easy layout. This also generates the amounts for the progress bar and caption.

While testing this to get all the code in place and the actions in order i think this will work.
Where im stuck: When progress bar is updated it just does 0% straight to 12% for example and i want it to more slowly move to the new position. Also I want to respond the macro that is being completed in that step but i dont think that is possible.
I hope this helps you understand what is going on and when I made this post i was stuck but as u see i have gotten past that. I would be welcome to any advice you have beause im not all that familiar with userforms and this is a collection of what i have found, people helped me with, and what i have been able to get to work.
I really thank you for your help.
 
Last edited:
Upvote 0
Capturethis one.JPG

my goal is to have something like this but have the bars combined into one
 
Upvote 0
Hopefully I understood everything correctly. To begin with, I've commented on your original code for the benefit of your learning curve. Below some snippets with my comments.

VBA Code:
Sub intprogress()
    Dim s As Integer                               ' << declaration of 's' at procedure level: local scope
                                                   '    VBA initializes 's' by assigning value 0
    With NightAuditP
        If s = 0 Then                              ' << 's' will always contain value 0; If...Then construct is superfluous
            NightAuditP.Previous.Enabled = False   ' <<  the NightAudiP part could have been left out because
        End If                                     '     of the With..End With construct
' 
'
Sub ProcessnaTEST()
    Dim s       As Integer
    Dim Prompt  As String

    s = VBAProject.NightAuditP.iStep

    CurrentProgress = VBAProject.NightAuditP.CurrentProgress        ' << this 3 lines each result in variables with local scope
    Progressprocentage = VBAProject.NightAuditP.Progressprocentage  ' << non of them were used, so superfluous
    Barwidth = VBAProject.NightAuditP.Barwidth
'
'


Then I removed duplicates / unnecessary code and finally made a progress bar with appropriate code. Below I mention the most striking changes:
- the procedure for placing the UserForm on the screen has been narrowed down to just one line of code;
- the separate ProcessnaTEST procedure has been canceled; its code has in a slightly amended form been moved to the UserForm module;
- additional code for a progress bar with de posibility for "a more slowly move to the new position ...";
- some " how to use" example code.

In order to make this progress bar perform as desired I am going to put you to work first, since a few controls need to be present / added to your UserForm. Make sure to follow the steps below carefully:
1. ad a Frame control with a horizontal elongated shape and with a height of aprox 100 or more. This will be adjusted to an acceptable height in a following step. This frame becomes the outer of your progress bar;
2. rename this frame to Frame_ProgBar;
3. ad three Label controls (of arbitrary dimensions) within this frame;
4. rename these labels in Lb_ProgBar_Done, Lb_ProgBar_Remain and Lb_ProgBar_Percent;
5. leave these label controls from of this point untouched, the code will calculate the right position and dimension for each of those controls;
6. resize the height of Frame_ProgBar to a desired height (but at least 22);
7. Done!

Regarding your wish of "a more slowly move to the new position ..." please note the following. The way you implement the progress bar has a direct effect on its behaviour. This is a matter of trial and error, after all the progress can only be displayed in relation to the amount of work of the total task, and not in relation to the (expected) time required.

ScreenShot131.png



Workbook Demo Jake975 (Dropbox)


This goes in a standard module:
VBA Code:
Option Explicit

Public bUsfAborted  As Boolean

Sub intprogress()

    NightAuditP.Show vbModeless

End Sub


' _____________ Example / template procedures used by userform NightAuditP______________

Public Sub TASK_Example_41(ByRef argUSF As Object, ByVal argSteps As Integer)

    ' to be launched from a UserForm with an appropriate progress bar

    Dim Max     As Long
    Dim i       As Long

    Max = 66000
    For i = 1 To Max
        ' not every loop an update of the progress bar, just once each 33rd loop
        If i Mod 33 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
        '[]
        '[]  perform some task ...
        '[]
    Next i
End Sub

Public Sub TASK_Example_42(ByRef argUSF As Object, ByVal argSteps As Integer)
    
    Dim Max     As Long
    Dim i       As Long
    Dim rng     As Range
    Dim c       As Range
    
    Set rng = Range("A1:AG2000")
    Max = rng.Count
    
    For Each c In rng
        ' range has 33 columns, on each row an update
        i = i + 1
        If i Mod 33 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
        '[]
        '[]  perform some task ...
        '[]
    Next c
End Sub

Public Sub TASK_Example_43(ByRef argUSF As Object, ByVal argSteps As Integer)
    
    Dim Max     As Long
    Dim i       As Long
    Dim arTmp   As Variant
    Dim x       As Long
    Dim y       As Long
    
    ' in the OUTER loop an update of the progress bar
    
    arTmp = Range("A1:AG2000")
    i = 1
    
    ' when a range is copied to an array LBound equals 1
    ' in other cases LBound could be 0
    If LBound(arTmp) = 1 Then
        Max = UBound(arTmp)
    Else
        Max = UBound(arTmp) + 1
    End If
    
    For x = LBound(arTmp) To UBound(arTmp)
        i = i + 1
        If bUsfAborted Then Exit Sub
        Call argUSF.ProgressBar_Update(i / Max / argSteps)
        For y = LBound(arTmp, 2) To UBound(arTmp, 2)
            '[]
            '[]  perform some task ...
            '[]
        Next y
    Next x
End Sub

Public Sub TASK_Example_44(ByRef argUSF As Object, ByVal argSteps As Integer)
    
    Dim Max     As Long
    Dim i       As Long
    Dim arTmp   As Variant
    Dim x       As Long
    Dim y       As Long
        
    ' in the INNER loop an update of the progress bar
    
    arTmp = Range("A1:AG2000")
    i = 1
    
    ' when a range is copied to an array LBound equals 1
    ' in other cases LBound could be 0
    If LBound(arTmp) = 1 Then
        Max = UBound(arTmp) * UBound(arTmp, 2)
    Else
        Max = (UBound(arTmp) + 1) * (UBound(arTmp, 2) + 1)
    End If
    
    For x = LBound(arTmp) To UBound(arTmp)
        For y = LBound(arTmp, 2) To UBound(arTmp, 2)
            i = i + 1
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
            '[]
            '[]  perform some task ...
            '[]
        Next y
    Next x
End Sub


Public Sub Task_ALL(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max     As Long
    Dim i       As Long
    Max = 200000
    For i = 1 To Max
        If i Mod 5 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Public Sub Task_ONE(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max             As Long
    Dim i               As Long
    Max = 100000
    For i = 1 To Max
        If i Mod 5 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Public Sub Task_TWO(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max             As Long
    Dim i               As Long
    Max = 100000
    For i = 1 To Max
        If i Mod 60 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Public Sub Task_THREE(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max             As Long
    Dim i               As Long
    Max = 100000
    For i = 1 To Max
        If i Mod 15 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub


This goes in the module of your Userform NightAuditP:
VBA Code:
Option Explicit

Private Const cStepCount    As Integer = 8      ' <<< step 0 is start of process and should not be counted

Private iStepCurrent        As Integer
Private siProgressPart      As Single
Private siProgressALL       As Single

Private ACTION


' _________ EXAMPLES _________

Private Sub Cbtn_Example1_Click()
    ' == Calling a single task ==
    siProgressALL = 0       ' << init before task
    Call Task_ALL(Me, 1)
    '                /^\
    '          1 task means 1 step
End Sub


Private Sub Cbtn_Example2a_Click()
    ' == Three consecutive tasks WITH a break ==
    siProgressALL = 0
    Call Task_ONE(Me, 3)
    siProgressALL = siProgressALL + siProgressPart
End Sub
Private Sub Cbtn_Example2b_Click()
    Call Task_TWO(Me, 3)
    siProgressALL = siProgressALL + siProgressPart
End Sub
Private Sub Cbtn_Example2c_Click()
    Call Task_THREE(Me, 3)
End Sub


Private Sub Cbtn_Example3_Click()
    ' == Three consecutive tasks WITHOUT a break ==
    siProgressALL = 0
    Call Task_ONE(Me, 3)
    siProgressALL = siProgressALL + siProgressPart
    Call Task_TWO(Me, 3)
    siProgressALL = siProgressALL + siProgressPart
    Call Task_THREE(Me, 3)
End Sub

Private Sub Cbtn_Example4_Click()
    ' == Four consecutive tasks WITHOUT a break ==
    siProgressALL = 0
    Call TASK_Example_41(Me, 4)
    siProgressALL = siProgressALL + siProgressPart
    Call TASK_Example_42(Me, 4)
    siProgressALL = siProgressALL + siProgressPart
    Call TASK_Example_43(Me, 4)
    siProgressALL = siProgressALL + siProgressPart
    Call TASK_Example_44(Me, 4)
End Sub


' __________ Jake975 CODE __________

Private Sub Previous_Click()
    Me.Tag = Previous.Caption
    ACTION = ""
    
    ' ensure iStepCurrent never becomes a negative number
    iStepCurrent = IIf(iStepCurrent - 1 <= 0, 0, iStepCurrent - 1)
    
    ' reduce length Progress Bar
    siProgressALL = IIf(siProgressALL - (1 / cStepCount) <= 0, 0, siProgressALL - (1 / cStepCount))
    Call ProgressBar_Update(argPart:=0)

    Call ShowMsg
End Sub

Private Sub Succeeding_Click()
    Me.Tag = Succeeding.Caption

    Select Case iStepCurrent
        Case 0
            ACTION = "Night Audit Checklist printed."
'>>            Call PNT2
            ACTION = "New folder being generated if not already made."
    'Action: this displays what is currently happening and i can update that in each macro to show while that macro is running
'>>            Call Makefolder
            ACTION = "Selecting foloder location"
            ''Call FolderPicker
        Case 1
            ACTION = ""
        Case 2
            ACTION = ""
        Case 3
            ACTION = ""
        Case 4
            ACTION = ""
    End Select

    ' ensure upper boundary is respected
    iStepCurrent = IIf(iStepCurrent + 1 >= cStepCount, cStepCount, iStepCurrent + 1)

    ' increase length progress bar
    siProgressALL = IIf(siProgressALL + (1 / cStepCount) >= 1, 1, siProgressALL + (1 / cStepCount))
    Call ProgressBar_Update(argPart:=0)

    Call ShowMsg
End Sub

'Private Sub Help_Click()
'    Me.Tag = Help.Caption
'
'    Select Case iStepCurrent
'        Case 0
'            MsgBox ("We are testing help")
'        Case 1
'            MsgBox ("We are testing help for the second time")
'        Case 2
'            MsgBox ("We are testing help for the last time")
'    End Select
'    Call ShowMsg
'End Sub

'Private Sub Cancel_Click() 'this will just close the form
'     Unload Me
'End Sub

Private Sub ShowMsg()

    Dim sMsg    As String

    Select Case iStepCurrent
        Case 0
                sMsg = "Are you ready to start the night audit file process?" & vbNewLine _
                & "This is for the date of: " & Format(Date - 1, "mm-dd-yyyy")
        Case 1
                sMsg = "Please Run End Of Day in Opera now." & vbNewLine & "Click OK AFTER Opera is completed."
        Case 2
                sMsg = "Have you saved the" & vbNewLine & "Adjustment Log" & vbNewLine _
                & " & " & vbNewLine & "Daily Cash Log?"
        Case 3
                sMsg = "Please save all required documents to complete final packet." & vbNewLine _
                & "Click OK once completed."
        Case 4
                sMsg = "The process will now get all related files." & vbNewLine & _
                "If the process is stopped here nothing will be changed." & vbNewLine & "Do You Wish To Continue?"
        Case 5
                sMsg = "All files will now be renamed." & vbNewLine _
                & "This process can not be undone!" & vbNewLine & "Do You Wish To Continue?"
        Case 6
                sMsg = "Have you made and saved all the notes on these files? :" & vbNewLine _
                & "Credit Card History.pdf" & vbNewLine & "Guest Ledger Detail.pdf" & vbNewLine & "Paid Out.pdf" _
                & vbNewLine & "Rate Variance.pdf"
        Case 7
                sMsg = "The process will now create a temperary file." & vbNewLine _
                & "This file is used for the final step."
        Case 8
                sMsg = "The final packet will be created and saved." & vbNewLine _
                & "This process can not be undone!" & vbNewLine & "Do You Wish To Continue?"
    End Select

    With Me
        .Question.Caption = sMsg
        .Previous.Caption = "Back"

        If iStepCurrent = 0 Then
            .Previous.Enabled = False
            .Succeeding.Caption = "Start"
            .Repair.Enabled = True
        Else
            .Previous.Enabled = True
            .Succeeding.Caption = "Next"
            .Repair.Enabled = False
        End If
    End With
End Sub


'  _________ Additional UserForm Procedures ____________

Private Sub UserForm_Terminate()
    bUsfAborted = True
End Sub

Private Sub UserForm_Initialize()
    bUsfAborted = False
    iStepCurrent = 0
    Me.Previous.Caption = "Back"
    Me.Previous.Enabled = False
    Call ProgressBar_Initialize
End Sub

Private Sub ProgressBar_Initialize()

    Me.Lb_ProgBar_Done.ZOrder 0
    Me.Lb_ProgBar_Percent.ZOrder 0

    With Me
        .Frame_ProgBar.Caption = ""
        With .Lb_ProgBar_Remain
            .Caption = ""
            .Top = -1
            .Left = -1
            .Height = Me.Frame_ProgBar.Height + 2
            .Width = Me.Frame_ProgBar.Width + 2
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleOpaque
            .BackColor = &H80000000
        End With
        With .Lb_ProgBar_Done
            .Caption = ""
            .Top = -1
            .Left = -1
            .Height = Me.Frame_ProgBar.Height + 2
            .Width = 0
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleOpaque
            .BackColor = 49152
        End With
        With .Lb_ProgBar_Percent
            .Caption = ""
            .Font.Size = 12             ' <<  with a FontSize of:  10   |  12  |  16
            .Height = 18                ' <<  assign a Height of:  12   |  18  |  24
            .Font.Name = "Tahoma"
            .Font.Bold = True
            .ForeColor = &H8000000E
            .Left = -1
            .Top = (Me.Lb_ProgBar_Done.Height / 2) - (.Height / 2)
            .Width = Me.Frame_ProgBar.Width + 2
            .TextAlign = fmTextAlignCenter
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleTransparent
        End With
    End With
End Sub

Public Sub ProgressBar_Update(argPart As Single)

    siProgressPart = argPart
    If siProgressALL < 0 Then siProgressALL = 0
    With Me
        .Lb_ProgBar_Done.Width = (siProgressALL + argPart) * (.Lb_ProgBar_Remain.Width - 2)
        .Lb_ProgBar_Percent.Caption = Format(siProgressALL + argPart, "0%")
        
            ' >> Jake975 specific code:
            .TextP.Caption = Format(siProgressALL + argPart, "0%") & " Complete"
        
    End With
    DoEvents    ' yield to OS for repainting this UserForm
End Sub
 
Upvote 0
Solution
thank you so much for your help I was able to merge the two files and get it working with the updates I had made and the structure from a more experience coder.
VBA Code:
Public Sub TASK_Example_41(ByRef argUSF As Object, ByVal argSteps As Integer)

    ' to be launched from a UserForm with an appropriate progress bar

    Dim Max     As Long
    Dim i       As Long

    Max = 66000
    For i = 1 To Max
        ' not every loop an update of the progress bar, just once each 33rd loop
        If i Mod 33 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
        '[]
      
        '[]
    Next i
    
End Sub

Public Sub TASK_Example_42(ByRef argUSF As Object, ByVal argSteps As Integer)
    
    Dim Max     As Long
    Dim i       As Long
    Dim rng     As Range
    Dim c       As Range
    
    Set rng = Range("A1:AG2000")
    Max = rng.Count
    
    For Each c In rng
        ' range has 33 columns, on each row an update
        i = i + 1
        If i Mod 33 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
        '[]
        '[]  perform some task ...
        '[]
    Next c
End Sub

Public Sub TASK_Example_43(ByRef argUSF As Object, ByVal argSteps As Integer)
    
    Dim Max     As Long
    Dim i       As Long
    Dim arTmp   As Variant
    Dim x       As Long
    Dim y       As Long
    
    ' in the OUTER loop an update of the progress bar
    
    arTmp = Range("A1:AG2000")
    i = 1
    
    ' when a range is copied to an array LBound equals 1
    ' in other cases LBound could be 0
    If LBound(arTmp) = 1 Then
        Max = UBound(arTmp)
    Else
        Max = UBound(arTmp) + 1
    End If
    
    For x = LBound(arTmp) To UBound(arTmp)
        i = i + 1
        If bUsfAborted Then Exit Sub
        Call argUSF.ProgressBar_Update(i / Max / argSteps)
        For y = LBound(arTmp, 2) To UBound(arTmp, 2)
            '[]
            '[]  perform some task ...
            '[]
        Next y
    Next x
End Sub

Public Sub TASK_Example_44(ByRef argUSF As Object, ByVal argSteps As Integer)
    
    Dim Max     As Long
    Dim i       As Long
    Dim arTmp   As Variant
    Dim x       As Long
    Dim y       As Long
        
    ' in the INNER loop an update of the progress bar
    
    arTmp = Range("A1:AG2000")
    i = 1
    
    ' when a range is copied to an array LBound equals 1
    ' in other cases LBound could be 0
    If LBound(arTmp) = 1 Then
        Max = UBound(arTmp) * UBound(arTmp, 2)
    Else
        Max = (UBound(arTmp) + 1) * (UBound(arTmp, 2) + 1)
    End If
    
    For x = LBound(arTmp) To UBound(arTmp)
        For y = LBound(arTmp, 2) To UBound(arTmp, 2)
            i = i + 1
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
          
            '[]  perform some task ...
            '[]
        Next y
    Next x
End Sub


Public Sub Task_ALL(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max     As Long
    Dim i       As Long
    Max = 200000
    For i = 1 To Max
        If i Mod 5 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Public Sub Task_ONE(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max             As Long
    Dim i               As Long
    Max = 100000
    For i = 1 To Max
        If i Mod 5 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Public Sub Task_TWO(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max             As Long
    Dim i               As Long
    Max = 100000
    For i = 1 To Max
        If i Mod 60 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Public Sub Task_THREE(ByRef argUSF As Object, ByVal argSteps As Integer)
    Dim Max             As Long
    Dim i               As Long
    Max = 100000
    For i = 1 To Max
        If i Mod 15 = 0 Then
            If bUsfAborted Then Exit Sub
            Call argUSF.ProgressBar_Update(i / Max / argSteps)
        End If
    Next i
End Sub

Where I'm stuck now is how do I use this code to call a macro once and update the progress bar during?
When I click the start button the progress bar goes straight to 13% but when I click example 3 or 4 (both move in a desired effect) the progress bar progresses 0-100%%
Here is an example of a macro I need to run once
VBA Code:
Sub FilePrint(strFilePath As String)
   ShellExecute Application.hwnd, "Print", strFilePath, 0&, 0&, SW_HIDE
End Sub
Sub PNT()
Call FilePrint("C:\Audit Reports\Compiled" + "\Night Audit " & Format(Date - 1, "mm-dd-yyyy") & ".pdf")
Call FilePrint("C:\Audit_Processing\Cash Deposit Log.xlsm")
Call FilePrint("C:\Audit Reports\Disembodied\" + Format(Date - 1, "mm-dd-yyyy") + "\Out of Order.pdf")
Call FilePrint("C:\Audit Reports\Disembodied\" + Format(Date - 1, "mm-dd-yyyy") + "\Manager Report.pdf")
End Sub
the first macro is used the print the file and the second macro is used to pass the file names to be printed.
normally I would just call PNT during the button click but I don't know how to call it in the code you gave me without calling it a lot of times
 
Last edited:
Upvote 0
You have set up a UserForm as a wizard like form, with a progress bar. Assume the wizard has an intro and eight following steps. After each step user input is expected, after the 8th step the wizard completes at 100%. This means each interval represents 1 / 8th of the total of tasks to be performed, so 1 / 8th part of the progress bar. So far so good.
The trick is to divide each task into as many sub-tasks as possible. If an interval (wizard step) task can be split up into 3 separate tasks each subtask represents 1 / 8 / 3 equals 1 / (8 * 3) equals 1 /24th of the progress bar. If one of those three separate tasks can be split up into four separate tasks, each of those four tasks represents 1 / 8 / 3 / 4 equals 1 / (8*3*4) equals 1 / 96th part of the totall progress bar.
Translating this to your UserForm it would be look like the following. Hopefully, it will now become somewhat clearer to you how to use the code.

Code behind the desired Click event in your UserForm module:
VBA Code:
Private Sub Succeeding_Click()
    Me.Tag = Succeeding.Caption

    Select Case iStepCurrent
        
        ' == EIGHT consecutive tasks WITH a break ==

        Case 0
            siProgressALL = 0       ' << init JUST ONCE for each 100% Progress Bar
            Call TASK_0             ' << procedure within userform
        Case 1
            ACTION = ""
            Call TASK_1             ' << procedure within userform
        '
        '
        '
        Case 8
            ACTION = ""
            Call TASK_8             ' << procedure within userform
    End Select

    ' ensure upper boundary is respected
    iStepCurrent = IIf(iStepCurrent + 1 >= cStepCount, cStepCount, iStepCurrent + 1)

    ' increase length progress bar
    siProgressALL = IIf(siProgressALL + (1 / cStepCount) >= 1, 1, siProgressALL + (1 / cStepCount))
    Call ProgressBar_Update(argPart:=0)

    Call ShowMsg
End Sub


Example of how your TASK_0 procedure could look like, to be placed in your UserForm module:
Rich (BB code):
Private Sub TASK_0()

    Const cPartCount As Long = 3                        ' <<<< THREE indivisible tasks

    ACTION = "Night Audit Checklist printed."
    
    Call PNT(Me, cStepCount * cPartCount)               ' <<<< first  1/24th part of progress bar
    siProgressALL = siProgressALL + siProgressPart

    ACTION = "New folder being generated if not already made."
'Action: this displays what is currently happening and i can update that in each macro to show while that macro is running
'>>            Call Makefolder(
    Call MakeFolder(Me, cStepCount * cPartCount)        ' <<<< second 1/24th part of progress bar
    siProgressALL = siProgressALL + siProgressPart
    
    ACTION = "Selecting foloder location"
    ''Call FolderPicker
    Call FolderPicker(Me, cStepCount * cPartCount)      ' <<<< third and last 1/24th part of progress bar
    siProgressALL = siProgressALL + siProgressPart      '      totally at this point: 3/24th equals 1/8th

End Sub


Revision of the PNT procedure, to be placed in a standard module.
Rich (BB code):
Public Sub PNT(ByRef argUSF As Object, ByVal argSteps As Integer)

    Const cPartCount As Integer = 4                     ' <<<< FOUR indivisible tasks

    
    Call FilePrint("C:\Audit Reports\Compiled" + "\Night Audit " & Format(Date - 1, "mm-dd-yyyy") & ".pdf")
        If bUsfAborted Then Exit Sub
        Call argUSF.ProgressBar_Update(1 / argSteps / cPartCount)   ' argSteps equals (8*3), so  1/24/4 equals 1/96th part of progress bar
        '                              /\    
    
    Call FilePrint("C:\Audit_Processing\Cash Deposit Log.xlsm")
        If bUsfAborted Then Exit Sub
        Call argUSF.ProgressBar_Update(2 / argSteps / cPartCount)
        '                              /\    
    Call FilePrint("C:\Audit Reports\Disembodied\" + Format(Date - 1, "mm-dd-yyyy") + "\Out of Order.pdf")
        If bUsfAborted Then Exit Sub
        Call argUSF.ProgressBar_Update(3 / argSteps / cPartCount)
        '                              /\    
    Call FilePrint("C:\Audit Reports\Disembodied\" + Format(Date - 1, "mm-dd-yyyy") + "\Manager Report.pdf")
        If bUsfAborted Then Exit Sub
'        Call argUSF.ProgressBar_Update(4 / argSteps / cPartCount)
        Call argUSF.ProgressBar_Update(1 / argSteps)
End Sub
 
Upvote 0
I want to make sure I'm on the right track and you look over the attachment and give me any more direction if you think I need it of if im good thus far.
Please let me know if you have any issues accessing file or saving
I know the on screen buttons don't work im focusing on the code in the userform and related macros
Thank you so much for all your time and help. :)
P.S. The "Action" from the cmdbttn is being moved to the related macros so it displays while it is running then clears when it is done.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,836
Messages
6,181,251
Members
453,027
Latest member
Lost_in_spreadsheets

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
Back
Top