Progress Meter

[jmersing]

I ahve some code that runs for about 5 minutes. I have cell displying the process in a percentage format. Does anyone know of a progress meter that I might be able to replace the percentage cell with?

Thanks

 

[Joe4]

The Microsoft Knowledge Base is usually a good source of information for stuff like this. Check out these two articles:

http://support.microsoft.com/default.aspx?scid=kb;en-us;170782&Product=xlw

http://support.microsoft.com/default.aspx?scid=kb;en-us;211736&Product=xlw

 

[jmersing]

Thats perfect, thanks

 

[jmersing]

I'm having some trouble with the progress meter (form) I created.
I foollowed the instructions, created an add-in and activated it inside my workbook.

But I'm not quite sure how to replace it's code Sub Main() with mine Sub()Tasks. My code is quite a bit different, looks like this:

Sub Tasks()
Dim need As Integer
'Application.ScreenUpdating = False
skillx = 9
timeStart = -1
timeStart2 = 1
For period = 1 To 12
timeStart2 = timeStart2 + 6
timeStart = timeStart + 8
For skilly = 104 To 124
skillNam = Sheet236.Cells(skillx, skilly).Value
need = Sheet236.Cells(period + 318, skilly - 97).Value - Sheet236.Cells(period + 304, skilly - 97).Value
If skillNam = "ENG" Then
Eng period, timeStart2, skilly, need ' Eng period, timeStart, skilly, need
ElseIf skillNam = "IND" Then
Ind period, timeStart, skilly, need
Else
OtherSkill period, timeStart, skilly, skillNam, need
End If

Next skilly
Next period
Application.ScreenUpdating = True
End Sub


Have any idea what Ineed to do?
Thanks!
Jim

 

[Nimrod]

jmersing

You've got code that runs for 5 minutes ? Are you interested of improving its time ... maybe to a point where a progress meter isn't needed . Could we see your code and an explaination of what it does ??

 

[Nimrod]

Andred Baker has created a non-modal progress screen that shows a progress bar, title and caption. Although the install file is 1.4mb the actual DLL is tiny and efficient. It's free and available from his web site:

http://www.vbusers.com/downloads/download.asp

 

[Nimrod]

Here's some instructions i've got tucked away from someone else... Haven't tried it but it sounds like it might meet your needs..

Display Status Messages In A Modeless UserForm

To display processing messages in a userform while your code is running, do the following:

1) Create a userform with a single label box on it and no buttons. Change the font on the label box to a large font. Change the caption on the userform to "Status" (or some other caption that you prefer)

2) On the userform's code module, select userform in the left drop down and Activate in the right dropdown. It will create the following two lines of code in the module:

Private Sub UserForm_Activate()

End Sub

3) In the above procedure, put the name of your main procedure. For example:

Private Sub UserForm_Activate()
'runs your main procedure. It can be any name you want
Main_Procedure
'unloads the form with the above procedure is done
Unload Me
End Sub

4) Assuming that the name of the userform is UserForm1, and that the name of the label is Label1, use statements like the following to display messages in the userform:

change the message in the user form
UserForm1.Label1.Caption = "any message you want"
'repaint the form so that the message is displayed
UserForm1.Repaint

5) To run your main code, create a procedure in a regular module that shows the user form:

6) Make certain that your error handling routines unload the userform if they stop execution.


To illustrate the above, put the following code in a regular module. The first procedure, called "Start_Up" is the one that you run. The second procedure, called "Main_Procedure" is the primary procedure.


Sub Start_Up()
UserForm1.Show
End Sub

Sub Main_Procedure()
Dim I As Integer

'write a message to the label
UserForm1.Label1.Caption = "Step one being done......."
'repaint the form so shat the above message is displayed
UserForm1.Repaint
'your code would go here; we've used Application.StatusBar to
'demonstrate that the code is executing
For I = 1 To 2000

Application.StatusBar = I
Next

'display a second status message in the dialog
UserForm1.Label1.Caption = "Step two being done......"
UserForm1.Repaint
For I = 1 To 2000
Application.StatusBar = I
Next

'display a third status message in the dialog
UserForm1.Label1.Caption = "Final step being done......"
UserForm1.Repaint
For I = 1 To 2000

Application.StatusBar = I
Next

'clear the status bar
Application.StatusBar = False
End Sub


Please note that it is very difficult to debug code while using the above code. The best approach is to only implement when you are done debugging.

The following is another way to use this approach:


Sub Main_Procedure()
StatusForm.Show
'If you need to step through your code, then put the
'statement "Unload StatusForm" at the point in your code
'where you wish to start stepping through it. Also put a
'breakpoint or Stop statement at that location.
End Sub

Sub Continuation_Procedure()
'called by activate procedure in StatusForm
Show_Message "Processing step 1"
'your code here

'more code here

Show_Message "Processing step 3"
'more code here
End Sub

Sub Show_Message(ByVal anyText)
StatusForm.Label1.Caption = anyText
StatusForm.Repaint
End Sub

 

[Justinlabenne]

Nimrod, the code you posted above is by far the easiest version of the progree meter i have found, no debug, worked perfect, threw a couple different codes of mine in, no problems, I had been toying w/ things like this, glad i was around to catch this post.

 

[Nimrod]

Hello Justinlabenne
Thx.... wish I could take credit for the code

Anyway you may also want to check out bakers site theres several cool downloads from his site ... including a modless progress bar and a demo xls sheet using it .

I've also installed Bakers AutoSave . His has some very nice features including length to save , period between events and number of file versions to save so that you can avoid overwrites. :wink:

 

[jmersing]

Nimrod,

The code that I have posted populates a work schedule that assigns tasks.
One of the reasons it runs slow is that is has a lot of Countif, Sumif, and array formula updating as the code is running. It really only takes about 1-2 mins to run which is OK. I just wanted to use the meter to appease the user. I created my own form, and can run it based on some code at the Knowledge base (see jmiskey's post) but I can't figure out where to run the code in my sub.

The code from the site is :
Sub Main()
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single

Application.ScreenUpdating = False
' Initialize variables.
Counter = 1
RowMax = 100
ColMax = 25

' Loop through cells.
For r = 1 To RowMax
For c = 1 To ColMax
'Put a random number in a cell
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c

' Update the percentage completed.
PctDone = Counter / (RowMax * ColMax)

' Call subroutine that updates the progress bar.
UpdateProgressBar PctDone
Next r
' The task is finished, so unload the UserForm.
Unload frmWait
End Sub

Sub UpdateProgressBar(PctDone As Single)
With frmWait

' Update the Caption property of the Frame control.
.FrameProgress.Caption = Format(PctDone, "0%")

' Widen the Label control.
.LabelProgress.Width = PctDone * _
(.FrameProgress.Width - 10)
End With

' The DoEvents allows the UserForm to update.
DoEvents
End Sub

Here is my Sub
Sub Tasks()
Dim need As Integer
'Application.ScreenUpdating = False
skillx = 9
timeStart = -1
timeStart2 = 1
For period = 1 To 12
timeStart2 = timeStart2 + 6
timeStart = timeStart + 8
For skilly = 104 To 124
skillNam = Sheet236.Cells(skillx, skilly).Value
need = Sheet236.Cells(period + 318, skilly - 97).Value - Sheet236.Cells(period + 304, skilly - 97).Value
If skillNam = "ENG" Then
Eng period, timeStart2, skilly, need ' Eng period, timeStart, skilly, need
ElseIf skillNam = "IND" Then
Ind period, timeStart, skilly, need
Else
OtherSkill period, timeStart, skilly, skillNam, need
End If

Next skilly
Next period
Application.ScreenUpdating = True
End Sub


Thanks for your help