Please can someone help me input this progress indictor into my macro

T

tonylpcs@yahoo.co.uk

Active Member
Joined
Dec 19, 2007
Messages
379
Hi Everyone,

I have recived some help from you all that has alowed me to follow simple instruction on the site bellow and i have managed to recreate the example they give perfectly , http://spreadsheetpage.com/index.php/site/tip/displaying_a_progress_indicator/
however i cant work out how to combine the code in there module listed below into my module code list below also so i get the progress bar to work fo my macro not send loads of random numbers everywhere.
my macro takes about 20 seconds to run so even if there was a timer in there that counts down would be fine i just want it to work, any of you code geniuses out there able to help me? please!

thanks

Tony

(there code that is used to put random numbers on a sheet whilst showing the progress bar is below)

HTML: 
Sub Main()
'   Inserts random numbers on the active worksheet
    Dim Counter As Integer
    Dim RowMax As Integer, ColMax As Integer
    Dim r As Integer, c As Integer
    Dim PctDone As Single
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    Cells.Clear
    Application.ScreenUpdating = False
    Counter = 1
    RowMax = 100
    ColMax = 25
    For r = 1 To RowMax
        For c = 1 To ColMax
            Cells(r, c) = Int(Rnd * 1000)
            Counter = Counter + 1
        Next c
        PctDone = Counter / (RowMax * ColMax)
        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
    Next r
    Unload UserForm1
End Sub

and my macro that i use on my spreedsheet that i want the progress bar to show when running is:

HTML: 
Sub PrintIt()
    Application.ScreenUpdating = False
    If WorksheetFunction.CountA(Sheets("Sheet1").Range("E5,E7,E9,E11,E13,E17,E21,E23,E25,E27,K9,K11,K15,K19,K21,K23,K25,K27,K29,K31,K35")) <> 21 Then
    MsgBox "All white cells must be completed, if no data plese input a zero", vbExclamation
    Exit Sub
End If
    Dim Answer As VbMsgBoxResult
    Answer = MsgBox("Are you sure you want to print? all data will be transfered if you click yes?", vbYesNo)
    If Answer = vbNo Then Exit Sub
'   Your print code

Application.EnableEvents = False
Dim msg As String
With ActiveSheet
   .PageSetup.PrintArea = "$B$1:$M$36"
   .PrintOut
End With
 Worksheets("Sheet2").Unprotect Password:="Spreedsheet"
Sheets("Sheet1").Range("E5").Copy
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E9").Copy
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E15").Copy
Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E27").Copy
Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E21").Copy
Sheets("Sheet2").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E23").Copy
Sheets("Sheet2").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K21").Copy
Sheets("Sheet2").Range("AH" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K17").Copy
Sheets("Sheet2").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K9").Copy
Sheets("Sheet2").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K35").Copy
Sheets("Sheet2").Range("M" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K15").Copy
Sheets("Sheet2").Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K25").Copy
Sheets("Sheet2").Range("O" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K31").Copy
Sheets("Sheet2").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K20").Copy
Sheets("Sheet2").Range("j" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E7").Copy
Sheets("Sheet2").Range("AB" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K29").Copy
Sheets("Sheet2").Range("AC" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K27").Copy
Sheets("Sheet2").Range("AD" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K23").Copy
Sheets("Sheet2").Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E5,G5,I5,K5,K9,E7,E9,K11,E13,K15,K19,K21,E21,K23,E23,K25,E25,K27,E27,K29,K31,K35").ClearContents
Sheets("Sheet1").Range("K23").Select
    ActiveCell.FormulaR1C1 = "0"
Sheets("Sheet1").Range("E25").Select
    ActiveCell.FormulaR1C1 = "0"
Sheets("Sheet1").Range("E11").Select
Sheets("Sheet1").Range("E11").Formula = "=E9+364"
Sheets("Sheet1").Range("K31").Select
Sheets("Sheet1").Range("K31").Formula = "=IF(I31=""Payment Date"",Q11,0)"
Sheets("Sheet1").Range("K29").Select
Sheets("Sheet1").Range("K29").Formula = "=IF(K27=""none"",0,"""")"
Sheets("Sheet1").Range("E25").Select
Sheets("Sheet1").Range("E25").Formula = "0"
Sheets("Sheet1").Range("E17").Select
Sheets("Sheet1").Range("E17").Formula = "5%"
Worksheets("Sheet2").Protect Password:="Spreedsheet"
Sheets("Sheet1").Range("E5").Select
ThisWorkbook.Save

ActiveWorkbook.Close savechanges:=False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

hope someone can help me!

Tony
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Hi Everyone,
I was a little shocked to see no one has replyed!

I havent found a problem no body can fix have I ?

any help from you geniuses would be greatly apresiated!

Thanks

Tony
 
Upvote 0
Change UserForm_Activate to:
Code: 
Private Sub UserForm_Activate()
    Call PrintIt
End Sub
Add this code to update the progress indicator:
Code: 
Sub Update_Progress(ByRef count As Integer, maxCount As Integer)

    Dim pctdone As Single
    
    count = count + 1
    pctdone = count / maxCount
    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

End Sub
Instead of calling PrintIt() directly, call it via the userform's activate handler using:
Code: 
Sub Print_With_Progress()
    ShowDialog
End Sub
Add these variables to PrintIt() (set maxSteps to the total number of progress steps):
Code: 
Dim numSteps As Integer, maxSteps As Integer
numSteps = 0: maxSteps = 30
Then update the progress indicator in your PrintIt() subroutine whenever required using:
Code: 
Update_Progress numSteps, maxSteps
And unload the form at the end using:
Code: 
Unload UserForm1
 
Upvote 0
Hi Im trying to follow your instructions but I just keep messing it up!
all im getting is just different tyoes of Errors! (mostly run errors) I must be doing it wrong!

Is there any chance you or someone would be kind enough to put the code together for me and tell me where to stick it! (the code that is!)

I currently have Module 3 (called printit)
and i click on the userform 1 and it comes up frame progress.

so is there any way you could put the macros together and just say Cut and paste this into printit to replace your macro in full and cut and past this into userform to replace your current macro ?

and if i need to create something else please tell me how to?

I realy do appreciate your help on this everyone I fell im so close now.

thanks

Tony
 
Upvote 0
Upload all of your code and highlight the lines with the runtime errors
 
Upvote 0
Ok so i click on userform1 and get the macro area up,
It says:
Userform (in one dropdown box) and Activate (in the next one)
The code is:
Code: 
Private Sub FrameProgress_Click()

End Sub

Private Sub UserForm_Activate()
    Call PrintIt
End Sub

Then i have mobule 3
And the code is:
Code: 
Sub PrintIt()
    Application.ScreenUpdating = False
    Sub Update_Progress(ByRef count As Integer, maxCount As Integer)

    Dim pctdone As Single
    
    count = count + 1
    pctdone = count / maxCount
    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
Dim numSteps As Integer, maxSteps As Integer
numSteps = 0: maxSteps = 30

    If WorksheetFunction.CountA(Sheets("Sheet1").Range("E5,E7,E9,E11,E13,E17,E21,E23,E25,E27,K9,K11,K15,K19,K21,K23,K25,K27,K29,K31,K35")) <> 21 Then
    MsgBox "All white cells must be completed, if no data plese input a zero", vbExclamation
    Exit Sub
End If
    Dim Answer As VbMsgBoxResult
    Answer = MsgBox("Are you sure you want to print? all data will be transfered if you click yes?", vbYesNo)
    If Answer = vbNo Then Exit Sub
'   Your print code

Application.EnableEvents = False
Dim msg As String
With ActiveSheet
   .PageSetup.PrintArea = "$B$1:$M$36"
   .PrintOut
   
End With
Update_Progress numSteps, maxSteps
 Worksheets("Sheet2").Unprotect Password:="Spreedsheet"
Sheets("Sheet1").Range("E5").Copy
Sheets("Sheet2").Range("B" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E9").Copy
Sheets("Sheet2").Range("C" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E15").Copy
Sheets("Sheet2").Range("D" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E27").Copy
Sheets("Sheet2").Range("F" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E21").Copy
Sheets("Sheet2").Range("G" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E23").Copy
Sheets("Sheet2").Range("H" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K21").Copy
Sheets("Sheet2").Range("AH" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K17").Copy
Sheets("Sheet2").Range("K" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K9").Copy
Sheets("Sheet2").Range("L" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K35").Copy
Sheets("Sheet2").Range("M" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K15").Copy
Sheets("Sheet2").Range("N" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K25").Copy
Sheets("Sheet2").Range("O" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K31").Copy
Sheets("Sheet2").Range("P" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K20").Copy
Sheets("Sheet2").Range("j" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E7").Copy
Sheets("Sheet2").Range("AB" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K29").Copy
Sheets("Sheet2").Range("AC" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K27").Copy
Sheets("Sheet2").Range("AD" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("K23").Copy
Sheets("Sheet2").Range("AE" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E5,G5,I5,K5,K9,E7,E9,K11,E13,K15,K19,K21,E21,K23,E23,K25,E25,K27,E27,K29,K31,K35").ClearContents
Sheets("Sheet1").Range("K23").Select
Update_Progress numSteps, maxSteps
    ActiveCell.FormulaR1C1 = "0"
Sheets("Sheet1").Range("E25").Select
    ActiveCell.FormulaR1C1 = "0"
Sheets("Sheet1").Range("E11").Select
Sheets("Sheet1").Range("E11").Formula = "=E9+364"
Sheets("Sheet1").Range("K31").Select
Sheets("Sheet1").Range("K31").Formula = "=IF(I31=""Payment Date"",Q11,0)"
Sheets("Sheet1").Range("K29").Select
Sheets("Sheet1").Range("K29").Formula = "=IF(K27=""none"",0,"""")"
Sheets("Sheet1").Range("E25").Select
Sheets("Sheet1").Range("E25").Formula = "0"
Sheets("Sheet1").Range("E17").Select
Sheets("Sheet1").Range("E17").Formula = "5%"
Worksheets("Sheet2").Protect Password:="Spreedsheet"
Sheets("Sheet1").Range("E5").Select
ThisWorkbook.Save
Update_Progress numSteps, maxSteps
ActiveWorkbook.Close savechanges:=False
Application.EnableEvents = True
Application.ScreenUpdating = True
Unload UserForm1
End Sub


I get copile error expected end sub, and it highlights the sub printit () in yellow
and the false in blue!
Code: 
Sub PrintIt()
    Application.ScreenUpdating = False
    Sub Update_Progress(ByRef count As Integer, maxCount As Integer)

    Dim pctdone As Single
    
    count = count + 1
    pctdone = count / maxCount
    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
Dim numSteps As Integer, maxSteps As Integer
numSteps = 0: maxSteps = 30

    If WorksheetFunction.CountA(Sheets("Sheet1").Range("E5,E7,E9,E11,E13,E17,E21,E23,E25,E27,K9,K11,K15,K19,K21,K23,K25,K27,K29,K31,K35")) <> 21 Then
    MsgBox "All white cells must be completed, if no data plese input a zero", vbExclamation
    Exit Sub

and thats as far as i get!

anyone help me?

please?
 
Upvote 0
You seem to have 2 threads for the same question, but hopefully this will help.

In UserForm1 (with controls as described on http://spreadsheetpage.com/index.php/site/tip/displaying_a_progress_indicator/):
Code: 
Private Sub UserForm_activate()
    Call PrintIt
End Sub
In your Module3, replacing PrintIt:
Code: 
Sub Print_With_Progress()
    ShowDialog
End Sub

Sub PrintIt()
    
Dim numSteps As Integer, maxSteps As Integer
numSteps = 0: maxSteps = 31
    
    Application.ScreenUpdating = False
    If WorksheetFunction.CountA(Sheets("Sheet1").Range("E5,E7,E9,E11,E13,E17,E21,E23,E25,E27,K9,K11,K15,K19,K21,K23,K25,K27,K29,K31,K35")) <> 21 Then
        MsgBox "All white cells must be completed, if no data plese input a zero", vbExclamation
        Exit Sub
    End If
    Dim Answer As VbMsgBoxResult
    Answer = MsgBox("Are you sure you want to print? all data will be transfered if you click yes?", vbYesNo)
    If Answer = vbNo Then Exit Sub
'   Your print code

Application.EnableEvents = False
Dim msg As String
With ActiveSheet
   .PageSetup.PrintArea = "$B$1:$M$36"
   .PrintOut
End With

Worksheets("Sheet2").Unprotect Password:="Spreedsheet"

Sheets("Sheet1").Range("E5").Copy
Sheets("Sheet2").Range("B" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E9").Copy
Sheets("Sheet2").Range("C" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E15").Copy
Sheets("Sheet2").Range("D" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E27").Copy
Sheets("Sheet2").Range("F" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E21").Copy
Sheets("Sheet2").Range("G" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E23").Copy
Sheets("Sheet2").Range("H" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K21").Copy
Sheets("Sheet2").Range("AH" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K17").Copy
Sheets("Sheet2").Range("K" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K9").Copy
Sheets("Sheet2").Range("L" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K35").Copy
Sheets("Sheet2").Range("M" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K15").Copy
Sheets("Sheet2").Range("N" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K25").Copy
Sheets("Sheet2").Range("O" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K31").Copy
Sheets("Sheet2").Range("P" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K20").Copy
Sheets("Sheet2").Range("j" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E7").Copy
Sheets("Sheet2").Range("AB" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K29").Copy
Sheets("Sheet2").Range("AC" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K27").Copy
Sheets("Sheet2").Range("AD" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K23").Copy
Sheets("Sheet2").Range("AE" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E5,G5,I5,K5,K9,E7,E9,K11,E13,K15,K19,K21,E21,K23,E23,K25,E25,K27,E27,K29,K31,K35").ClearContents
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K23").Select
    ActiveCell.FormulaR1C1 = "0"
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E25").Select
    ActiveCell.FormulaR1C1 = "0"
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E11").Select
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E11").Formula = "=E9+364"
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K31").Select
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K31").Formula = "=IF(I31=""Payment Date"",Q11,0)"
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K29").Select
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("K29").Formula = "=IF(K27=""none"",0,"""")"
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E25").Select
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E25").Formula = "0"
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E17").Select
Update_Progress numSteps, maxSteps

Sheets("Sheet1").Range("E17").Formula = "5%"

Unload UserForm1

Worksheets("Sheet2").Protect Password:="Spreedsheet"
Sheets("Sheet1").Range("E5").Select
ThisWorkbook.Save

ActiveWorkbook.Close savechanges:=False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Private Sub Update_Progress(ByRef count As Integer, maxCount As Integer)

    Dim pctdone As Single
    
    count = count + 1
    pctdone = count / maxCount
    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

End Sub
Run the Print_With_Progress macro, not PrintIt.

Edit - you also need this in Module3:
Code: 
Sub ShowDialog()
    UserForm1.LabelProgress.Width = 0
    UserForm1.Show
End Sub
 
Last edited:
Upvote 0
Brilliant!

It works, it just runs much faster than the macro,

any way i can slow it down?

do i just add more of those max steps code or something?

thank you so much for your help.

Tony
 
Upvote 0
Increase the number of calls to Update_Progress(). You could put a call after every .Copy statement (I called it after every .PasteSpecial). The maxSteps is the total number of calls to Update_Progress, so that the progress indicator gets to 100% at the last call. You hard-code this value manually by counting the number of calls. 31 is the number I counted in the code I posted.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
144
NdNoviceHlp
NdNoviceHlp
I
  • Solved
Simplify my working code please
Replies
7
Views
142
ipbr21054
I
H
  • Solved
Macro to speedy up process when copying Data
Replies
3
Views
67
Logit
Logit
C
  • Solved
Need Help VBA
2
Replies
10
Views
417
Trebor76
T
T
  • Question Question
This is so slow I have to run it overnight
Replies
4
Views
427
kevin9999
K

Forum statistics

Threads
1,223,627
Messages
6,173,424
Members
452,515
Latest member
Alicedonald9

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