Stepping a progess bar through a subroutine

**hod** · 06-06-2012, 04:10 PM

Hi, I’m very new to VBA and have been creating my first real macro for a real life situation at work.

It all seems to work how I want it to after several attempts at getting this far.

I managed to find a fantastic progress bar utility from these forums called KoolPrgBar (the guy that created this is a genius)

What I am trying to achieve is….

During one of the subroutine calls to save the workbook and clear the dreaded “you don’t have enough memory to complete this task” error (which seems to work for me) I want the progress bar to carry on increasing whilst running the sub routine but cant for the life of me work out how this can be done.

The following is the main macro that I run (please dont laugh, I did say this is my first attempt)….

Sub EOM_Data_Extraction()

' VBA code written by Paul Kinnear modified 01/06/2012

Application.ScreenUpdating = False
Application.StatusBar = "Please wait... carrying out EOM Data Extraction..."
Application.Calculation = xlCalculationManual
Application.WindowState = xlMinimized
'-- Call the Splash form
Dim frm As frmSplash
    Dim i As Integer
    Dim j As Double
    Set frm = New frmSplash
    frm.CloseMe = False
    frm.KoolPrgBar.Value = 0
    frm.Show False '-- Non Modal
    For i = 0 To 3 Step 10
    frm.KoolPrgBar.Value = i
    frm.Label7 = "Reading Data from Cleric and creating the EOM Data spreadsheet"
    For j = 1 To 100000
    DoEvents
    Next j
    Next i
 Call Data_From_Cleric
        For i = 3 To 6 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "...Creating and ordering tabs for EOM Data to extract to"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call New_tabs
        For i = 6 To 9 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Choose & Book"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Choose_and_Book
        For i = 9 To 12 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Budget Code Recharges"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Budget_Code_Recharges
        For i = 12 To 15 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Practice Based Commisioning"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call PBC
        For i = 15 To 18 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Social Care Partnership"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call SCP
        For i = 18 To 21 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Haemodialysis Contracted"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Haemodialysis_Contracted
        For i = 21 To 24 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Haemodialysis Extra Contractual Journeys"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Haemodialysis_ECJ
        For i = 24 To 27 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Eastern & Coastal PCT Contracted"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call EC_PCT_Contracted
        For i = 27 To 30 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Eastern & Coastal PCT Extra Contractual Journeys"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call EC_PCT_ECJ
        For i = 30 To 33 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Other PCTs Extra Contractual Journeys"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Other_PCTs_Contracted
        For i = 33 To 36 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Radiotherapy internal charges"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Radiotherapy
        For i = 36 To 39 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... Derry Unit internal charges"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Derry_Unit
        For i = 39 To 41 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Calculating spend by contract & reconciling against spend by resource"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Reconcile
        For i = 41 To 44 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Adjusting column widths for new EOM Data sheets"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Auto_Fit
        For i = 44 To 51 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing data, this may take 5 to 10 minutes depending on your computers speed"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call SaveWithoutCode
        For i = 51 To 58 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing data, this may take 5 to 10 minutes depending on your computers speed"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i

'***********************************************************************************************************************
'Using laptop to work out replacement for copy paste starts here
    Workbooks.Open Filename:= _
        "C:\Users\EKHUFT\Desktop\Excel 2003 files\MASTER RECHARGES copy to be sent to Finance.xls"
    ChDir "C:\Users\EKHUFT\Desktop\Excel 2003 files"
'
'**********************************************************************************************************************
Application.StatusBar = "EOM Data extracting to MASTER RECHARGES"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Call Copy_Data_to_MASTER_RECHARGES_Reconciliation
        For i = 58 To 70 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, Reconciliation"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_To_MASTER_RECHARGES_Renal
        For i = 70 To 73 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, Renal"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_EKHT
        For i = 73 To 76 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, EKHT"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_PBC
        For i = 76 To 79 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, PBC"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_PCT
        For i = 79 To 82 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, PCT"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHAREGES_SCP
        For i = 82 To 85 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, SCP"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_Other_PCT_ECJ
        For i = 85 To 88 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, Other"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_Choose_and_Book
        For i = 88 To 91 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, Choose and Book"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_Radiotherapy
        For i = 91 To 94 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, Radiotherapy"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Call Copy_Data_to_MASTER_RECHARGES_Derry_Unit
        For i = 94 To 97 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Writing Data to... MASTER RECHARGES, Derry Unit"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
Application.WindowState = xlNormal
Application.StatusBar = "Congratulations... EOM Data Extraction has completed successfully"
Application.ScreenUpdating = True
MsgBox "EOM Data Extraction has completed sucessfully", vbInformation, "Patient Transport Service"
    Windows("EOM Data Extraction V2.22").Activate
    ActiveWorkbook.Close savechanges:=False
    Application.DisplayAlerts = False
        For i = 97 To 100 Step 10
        frm.KoolPrgBar.Value = i
        frm.Label7 = "Updating and completing Data extraction"
        For j = 1 To 100000
        DoEvents
        Next j
        Next i
        frm.CloseMe = True
        Unload frm
End Sub

The subroutine comes in with the "Call SaveWithoutCode" and the code is...


Sub SaveWithoutCode()
    Dim a As Integer
    Dim sarrWS() As String
    ReDim sarrWS(1 To ThisWorkbook.Worksheets.Count)
        a = 0
    For Each WS In ThisWorkbook.Worksheets
        a = a + 1
    sarrWS(a) = WS.Name
    Call StepThroughProgressBar
    Next WS
    ThisWorkbook.Worksheets(sarrWS()).Copy
End Sub

Any ideas would be greatly appreciated, thanks

Stepping a progess bar through a subroutine

LinkBack

Thread Tools

Rate This Thread

Display

Threaded View

Stepping a progess bar through a subroutine

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions