How to add Progress Bar on existing macro script

[arnemenzo]

Hi All,

Can somebody help me on how to add progress bar with this existing vba script? Been trying to incorporate the progress bar based on the available data found on the net but feels so unlucky on how to make it work.

Below is the whole process script of my activity. The process time depends on the number of items being provided, so it changes the process duration from time to time. Is there a way to incorporate a progress bar to this existing script?

I have attached the link of the actual excel template with the raw filled raw data in 'FBL3N Extract' sheet. You may run directly the macro by clicking the 'Export GRIR Report' button.
Here's the link of the excel file. https://drive.google.com/open?id=0ByekNw18LadyNjgtRmdJN2xaOE0

Thanks in advance!

Sub Export_Data()


'FBL3N Conversion to Text
    
    Application.ScreenUpdating = False
    Sheets("FBL3N Extract").Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Sheets("FBL3N Extract").Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A1").Select
    
'FBL3N Formula
    
    Application.Calculation = xlManual
    Sheets("FBL3N Extract").Range("N2:Q2").Copy
    Sheets("FBL3N Extract").Range("N3:Q150000").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("FBL3N Extract").Calculate
    Sheets("FBL3N Extract").Range("N3:Q150000").Copy
    Sheets("FBL3N Extract").Range("N3:Q150000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'GRIR look up
    Application.Calculation = xlManual
    Sheets("GRIR_look_up").Range("A2:J2").Copy
    Sheets("GRIR_look_up").Range("A3:J150000").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("GRIR_look_up").Calculate
    Sheets("GRIR_look_up").Range("A3:J150000").Copy
    Sheets("GRIR_look_up").Range("A3:J150000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
  
'Refresh Pivot
    
    Application.Calculation = xlAutomatic
    Sheets("Macro Buttons").Select
    Range("A2").Select
    Range("B8").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    Range("K8").Select
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
    Range("A2").Select
    Range("M9").Select
    Selection.ShowDetail = True
    Range("A2").Select
    ActiveSheet.Name = ">90 Days"
    Range("B2").Select
    Sheets("Macro Buttons").Select
    Range("A2").Select
    Range("C7:I68").Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1").Select
    Range("C1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("C:C").NumberFormat = "mm/dd/yyyy"
    Columns("F:F").NumberFormat = "0.00"
    Range("A1").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("A1").Select
    Windows("AssureNet GRIR Macro Template.xlsb").Activate
    Range("A2").Select
    Sheets("Summary").Select
    Range("W1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("FBL3N Extract").Select
    Range("A3:Q150000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    
' Convert to Range the table


    Sheets(">90 Days").Select
    Range("A1").Select
    ActiveSheet.ListObjects(1).Unlist
    Sheets(Array(">90 Days", "Summary", "FBL3N Extract")).Select
    Sheets("FBL3N Extract").Activate
    Sheets(Array(">90 Days", "Summary", "FBL3N Extract")).Copy
    Sheets(">90 Days").Move After:=Sheets(3)
    Sheets("FBL3N Extract").Columns("N:Q").EntireColumn.Hidden = True
    Sheets("FBL3N Extract").Range("A1:A150000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Sheets(">90 Days").Columns("O:Q").EntireColumn.AutoFit
    
    Sheets(">90 Days").Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Sheets(">90 Days").Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Sheets(">90 Days").Columns("G:G").TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    
    Sheets("Summary").Select
    Range("A1").Select
    Application.ScreenUpdating = True
    Windows("AssureNet GRIR Macro Template.xlsb").Activate
    Sheets("Macro Buttons").Select
    Range("A1").Select
    If ActiveSheet.ProtectContents = False Then
        MsgBox "Please press Enter to continue and kindly save your exported file to" & vbCrLf & "Text (Tab Delimited) format. :)" & vbCrLf & vbCrLf & vbCrLf & "-EALVNEM "
         Exit Sub
    End If


End Sub

 

[arnemenzo]

Can someone help me here?