Results 1 to 2 of 2

Thread: Add a SIMPLE progress indicator/bar to an existing Macro?
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Apr 2019
    Posts
    62
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Add a SIMPLE progress indicator/bar to an existing Macro?

    Hi guys

    I've been trying to research how I could add a progress bar to an existing macro of mine but I can't seem to find a reliable tutorial (probably just my poor understanding!). I was wondering if anyone would be able to link me to or help me out with a simple progress indicator or progress bar that I could apply to my following Macro code? I would be EXTREMELY grateful! The macro isn't particular onerous but can take a while sometimes, so I thought a nice progress bar/indicator might look fancy! I would also like to understand the logic behind this so I can apply it to other macros that I use that are more comprehensive. Thank you so much for reading.

    Code:
    Sub BOMTest()
    
    
    ' Get customer workbook...
    Dim customerBook As Workbook
    Dim filter As String
    Dim caption As String
    Dim customerFilename As String
    Dim customerWorkbook As Workbook
    Dim targetWorkbook As Workbook
    
    
    Dim aCount As Integer, msg As String
    Const msg1 = "The BOM has been imported!" & vbCr & vbCr
    Const msg2 = " item(s) could not be found." & vbCr & vbCr & "Please update the 'Equipment Cost Lookup' sheet to add the pricing for the missing product code(s) and then try again."
    Const msg3 = "All items have been successfully imported."
    
    
    
    
    
    
    ' make weak assumption that active workbook is the target
    Set targetWorkbook = Application.ActiveWorkbook
    
    
    
    
    ' get the customer workbook
    filter = "Text files (*.xlsx),*.xlsx"
    caption = "Please select the BOM "
    customerFilename = Application.GetOpenFilename(filter, , caption)
    
    
    
    
    Set customerWorkbook = Application.Workbooks.Open(customerFilename)
    
    
    
    
    ' assume range is A1 - C10 in sheet1
    ' copy data from customer to target workbook
    Dim targetSheet As Worksheet
    Set targetSheet = targetWorkbook.Worksheets(1)
    Dim sourceSheet As Worksheet
    Set sourceSheet = customerWorkbook.Worksheets(1)
    
    
    
    
    targetSheet.Range("F14", "I48").Value = sourceSheet.Range("A2", "K48").Value
    
    
    
    
    ' Close customer workbook
    customerWorkbook.Close
    
    
    
    
    targetSheet.Range("F7").Value = customerFilename
    
    
    
    
    aCount = WorksheetFunction.CountIfs(Sheets("Dashboard").Range("J14:J64"), "Item Not Found", Sheets("Dashboard").Range("I14:I64"), ">0")
    If aCount = 0 Then msg = msg1 & msg3 Else msg = msg1 & aCount & msg2
    MsgBox msg, vbInformation
    End Sub

  2. #2
    Board Regular
    Join Date
    Feb 2015
    Posts
    145
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add a SIMPLE progress indicator/bar to an existing Macro?

    Pulling this from an old project, so hopefully it works out for you!
    I think I found this code somewhere, so sorry I don't remember where to give attribution to.

    On a UserForm, I have a label called labelExportProgress . Back Color is red and it's inside a square box called exportProgress to give the 'outline' of the progress bar, along with the % on top.
    The code to 'increase' the bar is
    Code:
    Sub UpdateProgressBar(PctDone As Single)
        With UserForm1
    
    
            'Update the Caption property of the Frame control.
            .exportProgress.Caption = Format(PctDone, "0%")
    
    
            'Widen the Label control.
            .labelExportProgress.Width = PctDone * _
                (.exportProgress.Width - 10)
        End With
    
    
        'The DoEvents allows the UserForm to update.
        DoEvents
    End Sub
    Within the other code I know how many I'm looping through total, and keep track of how many I've done, then update the progress bar
    Code:
    'Update the percentage completed.
                percentProgress = counter / numberOfFilesInFolder
                counter = counter + 1
                'Call subroutine that updates the progress bar.
                UpdateProgressBar percentProgress
    After the code ends, sometimes the progress bar is a little wonky (slightly not 100%, etc), so I just set to 100% after everything completes
    Code:
    Application.ScreenUpdating = True
    UpdateProgressBar (1) 'Set to 100% complete
    Last edited by ismii; Jun 13th, 2019 at 10:59 AM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •