Any way to create a progress bar for my macro?

[hallingh]

I have a macro that generates a report, and it takes a minute or two to execute. Is there any way I can create a progress bar to show the user how close it is to being done? I googled it, but didn't come up with anything that I could figure out how to apply to my code. My macro is this:

Private Sub MyMacro()
Dim R As Long
Dim S As Long
Dim T As Long
S = 10
R = 11
T = 18
Sheets("Optics Report").Activate
Do While (S < 71)
    ActiveSheet.Range("C" & S & ":C" & (S - 1)).Value = Sheets("Image Intensifying Optics").Range("C" & (T) & ":C" & (T - 1)).Value
    ActiveSheet.Range("E" & S & ":E" & (S - 1)).Value = Sheets("Image Intensifying Optics").Range("E" & (T) & ":E" & (T - 1)).Value
    ActiveSheet.Range("M" & S).Value = Sheets("Image Intensifying Optics").Range("M" & (T)).Value
    ActiveSheet.Range("P" & (S - 1) & ":P" & (S + 2)).Value = Sheets("Image Intensifying Optics").Range("P" & (T - 1) & ":P" & (T + 2)).Value
    ActiveSheet.Range("Q" & (S - 1) & ":T" & (S + 2)).Value = Sheets("Image Intensifying Optics").Range("Q" & (T - 1) & ":T" & (T + 2)).Value
    S = S + 4
    T = T + 4
    Loop
 
 
Do While (R < 73)
    If ActiveSheet.Range("Q" & R) = "" Then
    Sheets("Optics Report").Range("M" & R & ":M" & (R + 1)).EntireRow.Hidden = True
    Else
    Sheets("Optics Report").Range("M" & R & ":M" & (R + 1)).EntireRow.Hidden = False
    End If
R = R + 4
Loop
 
R = 10
T = 1
Do While (R < 71)
    If ActiveSheet.Range("M" & R) = "" Then
    Sheets("Optics Report").Range("C" & R & ":C" & (R - 1)).EntireRow.Hidden = True
    Else
    Sheets("Optics Report").Range("C" & R & ":C" & (R - 1)).EntireRow.Hidden = False
    Sheets("Optics Report").Range("A" & R & ":A" & (R - 1)).Value = T
    T = T + 1
    End If
R = R + 4
Loop

It runs each of those loops 6 times with diffferent values for the variables and different arguments within the do while loops.

Thanks!

Hank

 

[hallingh]

So when I'm adding this code to MyMacro, do I put this:

Application.ScreenUpdating = False
    Counter = 1
    RowMax = 100
    ColMax = 25
    For r = 1 To RowMax
        For c = 1 To ColMax

inside the loops or do the loops go inside that code?? I'm getting a bit confused as to how to actually put it together. I haven't tried executing the code yet, but what I have doesnt make any sense to me.

 

[hallingh]

Nevermind, I'm not sure that code is the best way to update the status with MyMacro as it has so many seperate loops it really wouldn't work. I just want it to go up by an incremental margin afte revery loop.

So there are 18 loops total. I just want the progress to go up by 100% / 18 every time a loop is complete.

 

[hallingh]

Can I just use this code:

With UserForm1
            .FrameProgress.Caption = Format(PctDone, "0%")
            .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        End With

And manually update PctDone after every loop is complete? That would be the easiest way to do it, but I'm not sure how to write it so it would work properly.

 

[VoG]

It would be something like

Do While (s < 71)
    ActiveSheet.Range("C" & s & ":C" & (s - 1)).Value = Sheets("Image Intensifying Optics").Range("C" & (t) & ":C" & (t - 1)).Value
    ActiveSheet.Range("E" & s & ":E" & (s - 1)).Value = Sheets("Image Intensifying Optics").Range("E" & (t) & ":E" & (t - 1)).Value
    ActiveSheet.Range("M" & s).Value = Sheets("Image Intensifying Optics").Range("M" & (t)).Value
    ActiveSheet.Range("P" & (s - 1) & ":P" & (s + 2)).Value = Sheets("Image Intensifying Optics").Range("P" & (t - 1) & ":P" & (t + 2)).Value
    ActiveSheet.Range("Q" & (s - 1) & ":T" & (s + 2)).Value = Sheets("Image Intensifying Optics").Range("Q" & (t - 1) & ":T" & (t + 2)).Value
    s = s + 4
    t = t + 4
    PctDone = (s - 10) / 15
        With UserForm1
            .FrameProgress.Caption = Format(PctDone, "0%")
            .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        End With
'       The DoEvents statement is responsible for the form updating
        DoEvents
Loop

 

[hallingh]

You are the absolute man. I still have some thinking to do, but showing me how the code would fit into my program just showed me how the code functions. Thanks a ton.

Hank

 

[hallingh]

Ok, so when I try to run it I got an error I've never seen before. The error says "Form already displayed; Can't show modally."

Here is my code:

Sub MyMacro()   'Puts together the Optics Report and updates the progress bar
Dim PctDone As Single
Dim r, S, T, Q As Long
S = 10
r = 11
Q = 10
Sheets("Optics Report").Activate
UserForm1.LabelProgress.Width = 0
[B][I]UserForm1.Show [/I][/B]
Do While (S < 71)   'Goes through the Image Intensifying Optics sheet and copies the values over to the Optics Report
    ActiveSheet.Range("C" & S & ":C" & (S - 1)).Value = Sheets("Image Intensifying Optics").Range("C" & (T) & ":C" & (T - 1)).Value
    ActiveSheet.Range("E" & S & ":E" & (S - 1)).Value = Sheets("Image Intensifying Optics").Range("E" & (T) & ":E" & (T - 1)).Value
    ActiveSheet.Range("M" & S).Value = Sheets("Image Intensifying Optics").Range("M" & (T)).Value
    ActiveSheet.Range("P" & (S - 1) & ":P" & (S + 2)).Value = Sheets("Image Intensifying Optics").Range("P" & (T - 1) & ":P" & (T + 2)).Value
    ActiveSheet.Range("Q" & (S - 1) & ":T" & (S + 2)).Value = Sheets("Image Intensifying Optics").Range("Q" & (T - 1) & ":T" & (T + 2)).Value
    S = S + 4
    T = T + 4
    PctDone = ((S / 438) / 3)
        With UserForm1
            .FrameProgress.Caption = Format(PctDone, "0%")
            .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        End With
'       The DoEvents statement is responsible for the form updating
        DoEvents
    Loop

The bold text is where the debugging identifies as the error. I have three blocks loops, with 6 loops in each block. This loop is the first of the first block, and the last loop of this block stops when S=438, which is why I wrote the PctDone code like that. The PctDone code in the next loop is written like this:

PctDone = ((S / 438) / 3) + ((r / 440) / 3)

And the third is written like this:

PctDone = ((S / 438) / 3) + ((r / 440) / 3) + ((Q / 439) / 3)

Why would I get this error? Is this written horribly wrong?

Hank

 

[VoG]

If you are showing the userform within that code then you should not be using

Sub ShowDialog()
    UserForm1.LabelProgress.Width = 0
    UserForm1.Show
End Sub

 

[hallingh]

I just took the code out of Mymacro and created Sub ShowDialog() in the module. Now it gave me the "Application Defined or Object Defined error"

I don't think I defined the ShowDialog Sub more than once, and I can't find it anywhere. Does it sound like that is the issue? The debug points to a piece of code that I know is not an issue as the error. I'm quite confused.

 

[VoG]

Which line of code is highlighted.

I'm beginning to think that you might be better off simply displaying some text in the status bar.

 

[hallingh]

In my userform code I call ShowDialog followed by MyMacro. Could that be where the issue is?

It's highlighting this:

ActiveSheet.Range("C" & S & ":C" & (S - 1)).Value = Sheets("Image Intensifying Optics").Range("C" & (T) & ":C" & (T - 1)).Value

which is the first line of code in the first loop.