VBA Progress Indicator within a nextrow loop

H

haffy311

Board Regular
Joined
Jan 20, 2011
Messages
84
Hello all,

Looking for help to add a userform pop-up status indicator

My current code that runs is below and I would like a user form to pop up and actively tell me the % complete

% complete is found by simple division = count of non empty cells in column Q / count of non empty cells in column A


Sub CopyCells()


Application.ScreenUpdating = False


Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim x As Long
For x = 2 To LastRow

NextRow = Sheets("Data Entry").Range("A" & Rows.Count).End(xlUp).Row


Sheets("Mass_concept").Range("A" & x & ":P" & x).Copy
Sheets("Data Entry").Select
Sheets("Data Entry").Range("A" & NextRow).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
Sheets("data").Select
Sheets("data").Range("F3:K3").Copy
Sheets("Mass_concept").Select
Sheets("Mass_concept").Range("Q" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False

Next x

Application.ScreenUpdating = True



End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Here's what I use. I can't post the form itself, so I'll just list its controls -- there are only four. Keep in mind you might have a problem because of turning off ScreenUpdating.
- Two labels called lblMajor and lblMinor; lblMajor has bold font.
- A progress bar called pbrProgress, which is in MSCOMCTL = Microsoft Windows Common Controls 6.0 (SP6)
- A text box called lblPercentage.

So at the beginning you load and show the form and use SetMaximum to set it as LastRow, and in your loop you use SetValue to each row's number (x).

Code: 
Option Explicit


' This implements a simple progress bar that shows two labels and percentage complete.
' It allows setting the title and both strings any time the value changes.


' STARTUP


Private Sub UserForm_Initialize()

    With Me.pbrProgress

        .Min = 0!
        .Max = 100!

        Me.SetValue .Min                        ' Sets up the percent too

    End With

End Sub


' KEYSTROKE EVENTS: Esc closes it


Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If KeyAscii = vbKeyEscape Then Unload Me

End Sub


' PROJECT-AVAILABLE ROUTINES: these set the min, max and value, adjusting when necessary


Friend Sub SetValue(NewValue As Single, Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)

    With Me.pbrProgress
    
        If NewValue < .Min Then .Min = NewValue
        If NewValue > .Max Then .Max = NewValue

        .Value = NewValue

    End With

    Call CalcPercentage(Title, Major, Minor)

End Sub


Friend Sub SetMinimum(NewMin As Single, Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)

    With Me.pbrProgress

        If NewMin > .Max Then .Max = NewMin
        If NewMin > .Value Then .Value = NewMin
        
        .Min = NewMin

    End With

    Call CalcPercentage(Title, Major, Minor)
End Sub


Friend Sub SetMaximum(NewMax As Single, Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)

    With Me.pbrProgress
        If NewMax < .Min Then .Min = NewMax
        If NewMax < .Value Then .Value = NewMax
        
        .Max = NewMax
    End With
    Call CalcPercentage(Title, Major, Minor)
End Sub


Friend Sub SetStrings(Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)
    If Title <> vbNullString Then Me.Caption = Title: DoEvents
    If Minor <> vbNullString Then Me.lblMinor.Caption = Minor: DoEvents
    If Major <> vbNullString Then Me.lblMajor.Caption = Major: DoEvents
End Sub


' PRIVATE ROUTINES


Private Sub CalcPercentage(Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)
    With Me.pbrProgress
        Me.lblPercentage.Caption = Format$((.Value - .Min) / (.Max - .Min), "0.0%"): DoEvents
    End With
    Call SetStrings(Title, Major, Minor)

End Sub
 
Upvote 0
The status bar continues to update when ScreenUpdating set to false


Test this simple macro by inserting it in a new workbook and running it from the worksheet (not from iinside VBA window)
- it writes data to a worksheet (to give it something to do and to provide the % complete)
- Status Bar (see bottom left of screen) shows ongoing status
Code: 
Sub UpdateStatusBar()
    Dim OldStatusBar, K As Long
    With Application
        .ScreenUpdating = False
        OldStatusBar = .DisplayStatusBar
        .DisplayStatusBar = True
        Range("A1:A50000").ClearContents
            For K = 1 To 50000
                Cells(K, 1) = WorksheetFunction.CountA(Range("A1:A50000")) / 500
                If K Mod 500 = 0 Then .StatusBar = Round(Cells(K, 1), 0) & " %"
            Next
        .StatusBar = False
    .DisplayStatusBar = OldStatusBar
    End With
End Sub
 
Last edited:
Upvote 0
thank you i will try this out


jjasmith4 said:
Here's what I use. I can't post the form itself, so I'll just list its controls -- there are only four. Keep in mind you might have a problem because of turning off ScreenUpdating.
- Two labels called lblMajor and lblMinor; lblMajor has bold font.
- A progress bar called pbrProgress, which is in MSCOMCTL = Microsoft Windows Common Controls 6.0 (SP6)
- A text box called lblPercentage.

So at the beginning you load and show the form and use SetMaximum to set it as LastRow, and in your loop you use SetValue to each row's number (x).

Code: 
Option Explicit


' This implements a simple progress bar that shows two labels and percentage complete.
' It allows setting the title and both strings any time the value changes.


' STARTUP


Private Sub UserForm_Initialize()

    With Me.pbrProgress

        .Min = 0!
        .Max = 100!

        Me.SetValue .Min                        ' Sets up the percent too

    End With

End Sub


' KEYSTROKE EVENTS: Esc closes it


Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If KeyAscii = vbKeyEscape Then Unload Me

End Sub


' PROJECT-AVAILABLE ROUTINES: these set the min, max and value, adjusting when necessary


Friend Sub SetValue(NewValue As Single, Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)

    With Me.pbrProgress
    
        If NewValue < .Min Then .Min = NewValue
        If NewValue > .Max Then .Max = NewValue

        .Value = NewValue

    End With

    Call CalcPercentage(Title, Major, Minor)

End Sub


Friend Sub SetMinimum(NewMin As Single, Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)

    With Me.pbrProgress

        If NewMin > .Max Then .Max = NewMin
        If NewMin > .Value Then .Value = NewMin
        
        .Min = NewMin

    End With

    Call CalcPercentage(Title, Major, Minor)
End Sub


Friend Sub SetMaximum(NewMax As Single, Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)

    With Me.pbrProgress
        If NewMax < .Min Then .Min = NewMax
        If NewMax < .Value Then .Value = NewMax
        
        .Max = NewMax
    End With
    Call CalcPercentage(Title, Major, Minor)
End Sub


Friend Sub SetStrings(Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)
    If Title <> vbNullString Then Me.Caption = Title: DoEvents
    If Minor <> vbNullString Then Me.lblMinor.Caption = Minor: DoEvents
    If Major <> vbNullString Then Me.lblMajor.Caption = Major: DoEvents
End Sub


' PRIVATE ROUTINES


Private Sub CalcPercentage(Optional Title As String = vbNullString, Optional Major As String = vbNullString, Optional Minor As String = vbNullString)
    With Me.pbrProgress
        Me.lblPercentage.Caption = Format$((.Value - .Min) / (.Max - .Min), "0.0%"): DoEvents
    End With
    Call SetStrings(Title, Major, Minor)

End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
398
skillilea
S
P
  • Solved
Counter in For Each loop
Replies
2
Views
213
Possum17
P
D
  • Question
VBA optimization advice
Replies
3
Views
146
bobsan42
bobsan42
excelbytes
  • Solved
VBA Code To Copy Data Into Next Blank Column
Replies
5
Views
144
mumps
mumps
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
133
willow1985
willow1985

Forum statistics

Threads
1,215,480
Messages
6,125,050
Members
449,206
Latest member
Healthydogs

Share this page

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