VBA Progress Bar

[Isabella]

Hi, i want to create a progress bar when running the below code, but i dont know how to add code to the below, i have checked the web for examples and they are task related, how can i create one for the below?

Sub Clear_Data()
Dim shtMLM As Worksheet
Dim ws As Worksheet
Set shtMLM = Sheets("Data")
Application.ScreenUpdating = False
For Each ws In Sheets(Array("MLM_Data", "Rec"))
    ws.Unprotect Password:="Pass"
Next ws
 If MsgBox("Danger you are about to clear MLM Raw_Data, are you sure you want to clear this?", vbYesNo + vbDefaultButton2) = vbYes Then
    With shtMLM
            Intersect(.UsedRange, .Rows("6:" & .Rows.Count)).ClearContents
    End With
End If
For Each ws In Sheets(Array("MLM_Data", "Rec"))
    ws.Protect Password:="Pass"
Next ws
End Sub

 

[gardnertoo]

This code doesn't look like it should take long enough for a progress bar to be worthwhile. How long does it take to execute?

 

[pmyk]

In VB Editor,
Add a label and name it lblBack
Add another label and name it lblFace
Let both of them have equal height, say 12.
Let both of them have equal width, say 500.
Set lblFace right on lblBack.
Now, let lblFace have width 0.
Run the Code. Type 1000 in input box and see the bar scrolling.
-P. Michael
revpmichael (at) yahoo (dot) com
======== ========= ===============
'Code in Userform1 is given below
'Command1 is in Userform1
Private z As Integer
'Private varBackLabel_Width As Integer
Public maxr As Long

Private Sub Command1_Click()
maxr = InputBox("Type Total No of records to be entered:", "No of Records!")
'MsgBox "maxr =" & maxr & "."
Call PBarLabelsShow
For z = 1 To maxr
ProgBar maxr
Static m As Long
'Debug.Print "before incrementing m = " & m
m = m + 1
'Debug.Print "after incrementing m = " & m
Select Case m
Case 1
Userform1.ListBox1.AddItem "1st m =" & m & "."
Case 2
Userform1.ListBox1.AddItem "2nd m = " & m & "."
Case 3
Userform1.ListBox1.AddItem "3rd m = " & m & "."
Case 4
Userform1.ListBox1.AddItem "4th m = " & m & "."
Case 5
Userform1.ListBox1.AddItem "5th m = " & m & "."
Case 6 To 9
Userform1.ListBox1.AddItem "6th to 9th m = " & m & "."
Case Else
Userform1.ListBox1.AddItem "Else 9 or above m = " & m & "."
End Select
If m = maxr Then
m = 0
End If
Next z
Call PBarLabelsHide
End Sub
Private Sub PBarLabelsShow()
Userform1.lblBack.Visible = True
Userform1.lblFace.Visible = True
End Sub
Private Sub PBarLabelsHide()
Userform1.lblBack.Visible = False
Userform1.lblFace.Visible = False
End Sub

==== ========== =========
'Code in Module1 is given below
'Private m_iMin As Integer
Private m_iMaxValue As Integer
Private m_iIncre As Integer
Private m_sWidth As Long
Private m_iValue As Long
Private y As Long
Private varWidOld As Long
Private PBMax As Long
Private AllMax As Long
Function ProgBar(PBMax As Long)
AllMax = PBMax
'Debug.Print "Function max" & AllMax
'MsgBox "in function. PBMax=" & PBMax & "."
m_iMaxValue = 1
m_iIncre = 1
Call PopulateListr
End Function
Private Sub PopulateListr()
Static varNewiValue As Integer
If varNewiValue = 0 Then
'MsgBox "going to clear listbox"
Userform1.ListBox1.Clear
End If
varNewiValue = varNewiValue + m_iIncre
m_sWidth = (Userform1.lblBack.Width / AllMax) * varNewiValue
'm_iValue = Abs(varNewiValue - m_iMin) + 1
m_iValue = varNewiValue
'Debug.Print "m_iValue = " & m_iValue
Static varWid As Long
'MsgBox "varWid=" & varWid & vbCrLf & _
"varWidOld=" & varWidOld & vbCrLf & _
"m_sWidth=" & m_sWidth
If varWid >= Userform1.lblBack.Width Then
varWid = 0
End If
'varWid = varWid + (m_iValue * m_sWidth) / m_iMaxValue
varWid = m_sWidth
varWidOld = varWid
'Debug.Print "m_iValue * 100 / AllMax = " & Int(m_iValue * 100 / AllMax)
With Userform1.lblFace
.Width = varWid
'.Caption = CStr(Int(m_iValue * 100 / m_iMaxValue)) & "%" 'CStr(Int(1 * 100 / 50)) & "%"
.Caption = CStr(Int(m_iValue * 100 / AllMax)) & "%" 'CStr(Int(1 * 100 / 50)) & "%"
End With
If varNewiValue = AllMax Then
varNewiValue = 0
m_iValue = 0
End If
DoEvents
Select Case AllMax
Case Is <= 50
For y = 1 To 1000000
Next y
Case Is <= 100
For y = 1 To 100000
Next y
Case Is <= 1000
For y = 1 To 10000
Next y
Case Is > 1000
'Do Nothing
End Select
End Sub
-P. Michael
revpmichael (at) yahoo (dot) com

 

[DonkeyOte]

Andy Pope provides a few examples of progress bars on his site: http://www.andypope.info/vba/pmeter.htm

(duped into posting on an old thread )

 

[EducatedFool]

One more option: (using Class Module ProgressIndicator)

 

[VoG]

This is good too: Control the LED Display in the StatusBar http://j-walk.com/ss/excel/files/developer.htm