• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 771
  • Last Modified:

Progress Bar Without Cancel Button

I got this link from this site : A VBA Progress Bar For Excel
which would work great, but now I don't know how to incorporate with below codes which also I got assistance from few of your experts:
1) Text Import Wizard:
Sub FullSummary()

Dim LastRow1 As Long
Dim LastRow2 As Long
Dim ws As Worksheet, wsR As Worksheet, wsC As Worksheet, wsNC As Worksheet
Dim content As Worksheet
Dim result As String
Dim data_range As String
Dim strTemp As String


    '-- this code is placed in a module, so first make sure that we are working on the summary sheet.
    Set ws = Worksheets("Summary")
    ws.Select
    
    ws.Cells(ws.Rows.Count, "H").End(xlUp).Font.bold = False
    ws.Cells(ws.Rows.Count, "I").End(xlUp).Font.bold = False
    ws.Cells(ws.Rows.Count, "J").End(xlUp).Font.bold = False
    
    '-- clear data cells
    data_range = Replace(ws.UsedRange.Address, "$A$1", "A5")
    Range(data_range).ClearContents
    
    '-- select data file
    result = Application.GetOpenFilename(FileFilter:="Monthly Data files, *.txt", Title:="Please Select A File")
    If result <> CStr(False) Then Workbooks.OpenText filename:=result _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(56, 1), _
        Array(64, 1), Array(68, 1), Array(98, 1), Array(111, 1), Array(124, 1), Array(137, 1), _
        Array(142, 1), Array(155, 1), Array(160, 1), Array(185, 1), Array(191, 1), Array(199, 1), _
        Array(224, 1), Array(227, 1), Array(231, 1), Array(234, 1), Array(238, 1), Array(240, 1), _
        Array(245, 1), Array(247, 1), Array(261, 1), Array(270, 1), Array(290, 1), Array(296, 1), _
        Array(309, 1), Array(321, 1), Array(332, 1), Array(336, 1), Array(341, 1), Array(344, 1), _
        Array(386, 1), Array(401, 1)), TrailingMinusNumbers:=True
    DoEvents
    Set content = Workbooks(Mid(result, InStrRev(result, "\") + 1)).ActiveSheet
    strTemp = Mid$(result, InStrRev(result, "\") + 1)
    
    '-- add headers
    content.Range("A1").EntireRow.Insert
    content.Range("F:F").Insert
    content.Range("C1") = "Corp"
    content.Range("D1") = "Area"
    content.Range("E1") = "Acct"
    content.Range("F1") = "Type"
    content.Range("G1") = "PCNT"
    content.Range("N1") = "Cust.No."
    content.Range("M1") = "Net"
    content.Range("P1") = "Inv.No."
    content.Range("AJ1") = "Vessels"
    
    '-- remove unwanted text
    content.Columns("AJ:AJ").Replace What:="=- ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    '-- remove totals from column AK
    content.Columns("AK:AK").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*total*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- insert account type lookup formulae
    
    LastRow1 = Cells(Rows.Count, "P").End(xlUp).Row
    content.Range("F2:F" & LastRow1).Formula = "=VLOOKUP(RC[-1],'[CommCalc.xls]Account-Type'!C1:C2,2,0)"
    content.Range("F:F").Copy
    content.Range("F:F").PasteSpecial xlPasteValues
    
    '-- find zero values
    content.Range("M2:M" & LastRow1).Formula = "=IF(RC[-3]=0,RC[-4],IF(RC[-3]>0,RC[-3],""""))"
    content.Range("M:M").Copy
    content.Range("M:M").PasteSpecial xlPasteValues
        
    '-- remove zero values from column M
    content.Columns("M:M").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- sort data
    content.UsedRange.Sort Key1:=Range("F2"), Key2:=Range("H2"), Order1:=xlAscending, Header:=xlYes
           
    '-- add vessel name row
    content.Range("AV2:AV" & LastRow1).Formula = "=Trim(CONCATENATE(RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2]))"
    content.Columns("AV").Copy
    content.Columns("AV").PasteSpecial xlPasteValues

    '-- copy remaining data
    content.UsedRange.Offset(1).Columns(5).Copy
    ws.Range("B5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(3).Copy
    ws.Range("C5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(4).Copy
    ws.Range("D5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(7).Copy
    ws.Range("E5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(36).Copy
    ws.Range("F5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(6).Copy
    ws.Range("G5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(9).Copy
    ws.Range("H5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(10).Copy
    ws.Range("I5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(14).Copy
    ws.Range("K5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(16).Copy
    ws.Range("L5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(48).Copy
    ws.Range("M5").PasteSpecial xlValues
    
    '-- add function
    LastRow2 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ws.Range("A5").Formula = "1"
    ws.Range("A6").Formula = "=A5+1"
    ws.Range("A6").AutoFill ws.Range("A6:A" & LastRow2)
    ws.Range("A6:A" & LastRow2).Copy
    ws.Range("A6:A" & LastRow2).PasteSpecial xlValues
    ws.Range("J5:J" & LastRow2).Formula = "=I5-H5"
    ws.Range("J5:J" & LastRow2).Copy
    ws.Range("J5:J" & LastRow2).PasteSpecial xlValues
    ws.Range("H" & LastRow2 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow2 & ")"
    ws.Range("H" & LastRow2 + 2).Font.bold = True
    ws.Range("I" & LastRow2 + 2).Formula = "=SUBTOTAL(9,I5:I" & LastRow2 & ")"
    ws.Range("I" & LastRow2 + 2).Font.bold = True
    ws.Range("J" & LastRow2 + 2).Formula = "=SUBTOTAL(9,J5:J" & LastRow2 & ")"
    ws.Range("J" & LastRow2 + 2).Font.bold = True
    ws.Range("F4:F" & LastRow2).Replace What:="Charter hire of ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    '-- close data file
    
    ws.AutoFilterMode = False
    Application.Goto ws.Range("A5:A" & LastRow2), True
    ws.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    ws.Columns("A:A").EntireColumn.AutoFit
    ws.Columns("F:F").EntireColumn.AutoFit
    ws.Columns("G:G").EntireColumn.AutoFit
    ws.Cells(ws.Rows.Count, "J").End(xlUp).Select
        
    '-- this code is placed in a module, so first make sure that we are working on the Revenue sheet.
    Set wsR = Worksheets("Revenue_Summary")
    Set wsC = Worksheets("CABGOC")
    Set wsNC = Worksheets("NONCABGOC")
    wsR.Select
    
    wsR.Cells(wsR.Rows.Count, "H").End(xlUp).Font.bold = False
    wsR.Cells(wsR.Rows.Count, "I").End(xlUp).Font.bold = False
    wsR.Cells(wsR.Rows.Count, "J").End(xlUp).Font.bold = False
    
    '-- clear data cells for Revenue_Summary
    data_range = Replace(wsR.UsedRange.Address, "$A$1", "A5")
    Range(data_range).ClearContents
   
    DoEvents
    content.Activate
    
    '-- sort data by vessels
    content.UsedRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
    
    '-- keep only revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter Field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- delete other revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter Field:=6, Criteria1:="OTHER REVENUE"
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- remove maintenance from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*maintenance*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- remove taut from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*taut*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- copy remaining data
    content.UsedRange.Offset(1).Columns(5).Copy
    wsR.Range("B5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(3).Copy
    wsR.Range("C5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(4).Copy
    wsR.Range("D5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(7).Copy
    wsR.Range("E5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(36).Copy
    wsR.Range("F5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(6).Copy
    wsR.Range("G5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(9).Copy
    wsR.Range("H5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(10).Copy
    wsR.Range("I5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(14).Copy
    wsR.Range("K5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(16).Copy
    wsR.Range("L5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(48).Copy
    wsR.Range("M5").PasteSpecial xlValues
    
    '-- add function
    LastRow2 = wsR.Cells(wsR.Rows.Count, "B").End(xlUp).Row
    wsR.Range("A5").Formula = "1"
    wsR.Range("A6").Formula = "=A5+1"
    wsR.Range("A6").AutoFill wsR.Range("A6:A" & LastRow2)
    wsR.Range("A6:A" & LastRow2).Copy
    wsR.Range("A6:A" & LastRow2).PasteSpecial xlValues
    wsR.Range("J5:J" & LastRow2).Formula = "=I5-H5"
    wsR.Range("J5:J" & LastRow2).Copy
    wsR.Range("J5:J" & LastRow2).PasteSpecial xlValues
    wsR.Range("H" & LastRow2 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow2 & ")"
    wsR.Range("H" & LastRow2 + 2).Font.bold = True
    wsR.Range("I" & LastRow2 + 2).Formula = "=SUBTOTAL(9,I5:I" & LastRow2 & ")"
    wsR.Range("I" & LastRow2 + 2).Font.bold = True
    wsR.Range("J" & LastRow2 + 2).Formula = "=SUBTOTAL(9,J5:J" & LastRow2 & ")"
    wsR.Range("J" & LastRow2 + 2).Font.bold = True
    wsR.Range("F4:F" & LastRow2).Replace What:="Charter hire of ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    '-- close data file
    content.Parent.Close False
    wsR.AutoFilterMode = False
    Application.Goto wsR.Range("A5:A" & LastRow2), True
    wsR.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    wsC.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    wsNC.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    wsR.Columns("A:A").EntireColumn.AutoFit
    wsR.Columns("F:F").EntireColumn.AutoFit
    wsR.Activate
    wsR.Cells(wsR.Rows.Count, "J").End(xlUp).Select
        
End Sub

Open in new window


2) Splitting VBA to specific criteria:
Public Sub CopyRows()

Sheets("Revenue_Summary").Select

' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
NextRow_CABGOC = 5
NextRow_NONCABGOC = 5

    'clear previous contents (keep if you'd like to ensure no old data remains)
    LastRow = Sheets("CABGOC").Range("G65536").End(xlUp).Row
    If LastRow > 1 Then
        With Sheets("CABGOC").Range("A5:J" & LastRow)
            .Cells(.Rows.Count, "G").End(xlUp).Font.bold = False
            .Cells(.Rows.Count, "H").End(xlUp).Font.bold = False
            .ClearContents
        End With
    End If
    LastRow = Sheets("NONCABGOC").Range("G65536").End(xlUp).Row
    If LastRow > 1 Then
        With Sheets("NONCABGOC").Range("A5:J" & LastRow)
            .Cells(.Rows.Count, "G").End(xlUp).Font.bold = False
            .Cells(.Rows.Count, "H").End(xlUp).Font.bold = False
            .ClearContents
        End With
    End If
    
' Loop through each row
For x = 5 To FinalRow

    ' Decide if to copy based on column K
    ThisValue = Range("K" & x).Value
    
        If ThisValue = "85175" Then
            Range("A" & x & ":M" & x).Copy
            Sheets("CABGOC").Select
            Range("A" & NextRow_CABGOC).Select
            ActiveSheet.Paste
            Range("K" & NextRow_CABGOC).Value = "1000" & Range("K" & NextRow_CABGOC).Value
            Sheets("Revenue_Summary").Select
            NextRow_CABGOC = NextRow_CABGOC + 1
        Else
            If ThisValue <> "85175" Then
                Range("A" & x & ":M" & x).Copy
                Sheets("NONCABGOC").Select
                Range("A" & NextRow_NONCABGOC).Select
                ActiveSheet.Paste
                Range("K" & NextRow_NONCABGOC).Value = "1000" & Range("K" & NextRow_NONCABGOC).Value
                Sheets("Revenue_Summary").Select
                NextRow_NONCABGOC = NextRow_NONCABGOC + 1
            End If
        End If
Next x
        
End Sub

Open in new window


3) Formatting the end result:
Public Sub AddFunction()

Sheets("CABGOC").Select

    'add function
    LastRow = Sheets("CABGOC").Range("G65536").End(xlUp).Row
    If LastRow > 1 Then
        With Sheets("CABGOC").Range("A1:K" & LastRow)
            .Columns("G:I").Delete Shift:=xlToLeft
            .Columns("H:H").EntireColumn.Insert Shift:=xlToRight
            .Range("G4") = "Amt"
            .Range("H4") = "Comm_Amt"
            .Range("I4") = "Cust_No."
            .Range("J4") = "Inv.No."
            .Range("A5").Formula = "1"
            .Range("A6").Formula = "=A5+1"
            .Range("A6").AutoFill .Range("A6:A" & LastRow)
            .Range("A6:A" & LastRow).Copy
            .Range("A6:A" & LastRow).PasteSpecial xlValues
            .Range("H5:H" & LastRow).Formula = "=RC[-1]*10%"
            .Range("H5:H" & LastRow).Copy
            .Range("H5:H" & LastRow).PasteSpecial xlValues
            .Columns("K:K").Delete Shift:=xlToLeft
            .Range("G" & LastRow + 2).Formula = "=SUBTOTAL(9,G5:G" & LastRow & ")"
            .Range("G" & LastRow + 2).Font.bold = True
            .Range("H" & LastRow + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow & ")"
            .Range("H" & LastRow + 2).Font.bold = True
            .Columns("G:H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            .Rows("4:4").Font.bold = True
            .Rows("4:4").HorizontalAlignment = xlCenter
            .Rows("4:4").VerticalAlignment = xlCenter
            .Columns("A:A").EntireColumn.AutoFit
            .Columns("C:J").EntireColumn.AutoFit
            Application.Goto .Range("A5:A" & LastRow), True
            .Range("G65536").End(xlUp).Select
        End With
    End If
    LastRow = Sheets("NONCABGOC").Range("G65536").End(xlUp).Row
    If LastRow > 1 Then
        With Sheets("NONCABGOC").Range("A1:K" & LastRow)
            .Columns("G:I").Delete Shift:=xlToLeft
            .Columns("H:H").EntireColumn.Insert Shift:=xlToRight
            .Range("G4") = "Amt"
            .Range("H4") = "Comm_Amt"
            .Range("I4") = "Cust_No."
            .Range("J4") = "Inv.No."
            .Range("A5").Formula = "1"
            .Range("A6").Formula = "=A5+1"
            .Range("A6").AutoFill .Range("A6:A" & LastRow)
            .Range("A6:A" & LastRow).Copy
            .Range("A6:A" & LastRow).PasteSpecial xlValues
            .Range("H5:H" & LastRow).Formula = "=RC[-1]*10%"
            .Range("H5:H" & LastRow).Copy
            .Range("H5:H" & LastRow).PasteSpecial xlValues
            .Columns("K:K").Delete Shift:=xlToLeft
            .Range("G" & LastRow + 2).Formula = "=SUBTOTAL(9,G5:G" & LastRow & ")"
            .Range("G" & LastRow + 2).Font.bold = True
            .Range("H" & LastRow + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow & ")"
            .Range("H" & LastRow + 2).Font.bold = True
            .Columns("G:H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            .Rows("4:4").Font.bold = True
            .Rows("4:4").HorizontalAlignment = xlCenter
            .Rows("4:4").VerticalAlignment = xlCenter
            .Columns("A:A").EntireColumn.AutoFit
            .Columns("C:J").EntireColumn.AutoFit
            Application.Goto .Range("A5:A" & LastRow), True
            .Range("G65536").End(xlUp).Select
        End With
    End If
        Application.CutCopyMode = False
      
End Sub

Open in new window


4) Creating a New Workbook for one Criteria among above end result:
Sub NewWorkbook()

Worksheets(Array("CABGOC", "NONCABGOC")).Copy

Set wbNew = ActiveWorkbook
With wbNew
    ActiveWorkbook.SaveAs filename:=ThisWorkbook.Path _
& "\" & "SML COMMISSION" & "_" & Range("B3").Value
    .Close
End With
End Sub

Open in new window


5) Creating second new worksheet among above criteria:
Sub RevWorkbook()

Worksheets(Array("Summary", "Revenue_Summary", "CABGOC", "NONCABGOC")).Copy

Set wbNew = ActiveWorkbook
With wbNew
    ActiveWorkbook.SaveAs filename:=ThisWorkbook.Path _
& "\" & "TDW REV" & "_" & Range("B3").Value
Sheets("Summary").Select
ActiveSheet.Shapes(1).Delete
    .Close SaveChanges:=True
    
End With
End Sub

Open in new window


6) Finally calling all above codes to execute with msgbox vbyesno:
Sub ClickMe()
Dim ReturnValue As Integer
Dim RevenueValue As Integer

Application.DisplayAlerts = False
Call FullSummary
Call CopyRows
Call AddFunction
ReturnValue = MsgBox("Do You Wish To Create SML_Commission File For LuandaFinance?", vbYesNo)
    Select Case ReturnValue
    Case vbYes
    Call NewWorkbook
    Case vbNo
    Exit Sub
    End Select
RevenueValue = MsgBox("Do You Wish To Create TDW_REV File?", vbYesNo)
    Select Case ReturnValue
    Case vbYes
    Call RevWorkbook
    Case vbNo
    Exit Sub
    End Select
    Application.DisplayAlerts = True
Sheets("Summary").Activate
End Sub

Open in new window


I request you all to please help me to get linked progress bar running with above codes, but I don't want Cancel Button on progress bar and I think we may still use progress bar instead of msgbox for vbyesno.

Thanking you in advance, please guide me to get going.
0
Shums
Asked:
Shums
  • 5
  • 3
1 Solution
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Hello,

that seems a lot of code for a progress bar. I prefer John Walkenbach's approach, documented here: http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

It works with a userform and just a handful of lines of code to set up the form. Then in your main code you need to have a counter and update the form every once in a while.

Works great and is easy to customise.

cheers, teylyn
0
 
ShumsAsst. Financial ControllerAuthor Commented:
Thanks Teylyn,

I did came around with this Progress Indication, but I am not expert like you, I can do changes only if experts guides me. Yes obviously its easy to customize for you, but for me still a difficult task. I would be so grateful if you can update this form in my codes. Please help.....
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
If you use VBA code and need to maintain VBA code, at some point in time you will need to understand what the VBA code actually does. You can try to get help on forums like EE, and experts will be happy to help you with a question, but EE cannot be your only resource for maintaining your VBA code.

For one, you will get responses from different experts, with different levels of expertise and different coding styles. Suggestions given in one question will not necessarily marry up with suggestions given in another question.

For two, you will need to understand your code so you can make adjustments if your framework or circumstances change. If you feel that this is way over your head, then I strongly suggest that you invest in an experienced VBA programmer to do the work for you.

Again, at EE we are happy to help you with a specific issue, but this is not a free coding service.

If you can explain which parts of the code you want to apply the progress bar to and what determines the progress to be shown, then someone will be able to help you with that.

So:
- what determines the progress to be shown on the progress bar? In which of the subs you posted above does that processing happen?

If you can identify that, then we can add a counter variable before that code and tie it to the progress bar.

cheers, teylyn
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
ShumsAsst. Financial ControllerAuthor Commented:
Hi Teylyn,

That's very well explained what EE can do for us, honestly, I was under impression, EE can help you in any help you want with coding, but now I am clear, I must try myself first and if I am stuck somewhere then I must ask help on EE. I truly appreciated your advice and recommendation.

I am trying to show progressbar in sub Click Me, because it does call all other sub-routes. I know as per my knowledge, I may stuck for vbyes/no, which pops out msgbox.
0
 
ShumsAsst. Financial ControllerAuthor Commented:
OK Teyleyn,

I tried as per your advice I am as per below code, which is working perfect:
Public CounterUpdate As Integer

Sub Main()
    Dim Counter As Integer
    Dim EndCount As Integer
    Dim PctDone As Single

    Application.ScreenUpdating = False
        'Initalise variables
    Counter = 0
    EndCount = 100
    
    For CounterUpdate = 1 To EndCount
        Counter = Counter + CounterUpdate
    
        ' Update the percentage completed.
        PctDone = Counter / EndCount

        ' Call subroutine that updates the progress bar.
        UpdateProgressBar PctDone
    Next CounterUpdate
    
    ' The task is finished, so unload the UserForm.
    Unload ProgressBar
End Sub
Sub UpdateProgressBar(PctDone As Single)
    With ProgressBar

        ' Update the Caption property of the Frame control.
        .FrameProgress.Caption = Format(PctDone, "0%")
        .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
       
    End With

    ' The DoEvents allows the UserForm to update.
    DoEvents
End Sub
Sub ClickMe()
Dim ReturnValue As Integer
Dim RevenueValue As Integer

ProgressBar.Show

Application.DisplayAlerts = False
Call FullSummary
Call UpdateProgressBar(0.3)
Call CopyRows
Call UpdateProgressBar(0.6)
Call AddFunction
Call UpdateProgressBar(1)
Unload ProgressBar
ReturnValue = MsgBox("Do You Wish To Create SML_Commission File For LuandaFinance?", vbYesNo)
    Select Case ReturnValue
    Case vbYes
    Call NewWorkbook
    Case vbNo
    Exit Sub
    End Select
RevenueValue = MsgBox("Do You Wish To Create TDW_REV File?", vbYesNo)
    Select Case ReturnValue
    Case vbYes
    Call RevWorkbook
    Case vbNo
    Exit Sub
    End Select
    Application.DisplayAlerts = True
Sheets("Summary").Activate
MsgBox ("Reports Saved In The Same Directory, Where You Have CommCalc Excel File")
End Sub

Open in new window


Now my question is, can't we have ProgressBar to ask Application.Dialogs to select file and for vbyes/no, instead of msgbox.

Please now don't ask me to do it myself, I know this would be very difficult task for me.

Thanking you in advance.
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Sorry, I don't follow.

The progress bar code I linked to above uses a UserForm. The UserForm is loaded first and it launches the macro. The macro has a counter variable and updates the user form with the new settings/counter values.

cheers, teylyn
0
 
ShumsAsst. Financial ControllerAuthor Commented:
Yes Sir,

In my code UserForm is ProgressBar, which I renamed, and Counter Variable is in Main Sub Module, which is loading UserForm(ProgressBar) first. And for vbyes/no I just added two Command Button on UserForm(ProgressBar) namely SML_Commission File & TDW_REV File, and removed msgbox completely from above vba. Now everything is working perfect.....

Thank you very much for your support and guidance....
0
 
ShumsAsst. Financial ControllerAuthor Commented:
Task Completed.....
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now