Need to assign a progress bar while the macro is running.

[Pankaj Jaswani]

Sub Stage1()
Dim ColArr, CritArr, Col As Long, i As Long, lr As Long, LastRw As Long, c As Range, RngN As Range
ColArr = [{23,16,5}]: CritArr = [{"Demo Phone", "HemantNirania-04953","Frozen", "Inventory loss completed"}]
With Sheets("Price List"): lr = .Cells(.Rows.Count, 1).End(xlUp).Row: End With
With Sheets("Act Data Process"): LastRw = .Cells(.Rows.Count, 1).End(xlUp).Row: End With
Sheets("Act Data Process").Cells.ClearContents
Sheets("Act Dump").UsedRange.Copy Sheets("Act Data Process").Range("A1")
With Sheets("Act Data Process").Activate
With Sheets("Act Data Process").Cells(1).CurrentRegion
    With .Columns(21)
        .Value = Evaluate("=If(Row(" & .Address & "),LEFT((" & .Address & "),10))")
        .NumberFormat = "DD-MMM-YYYY"
    End With
    .Sort .Cells(1, 21), xlAscending, , , , , , xlYes
    For i = 1 To 2
        Col = IIf(i = 1, 16, 22)
        With .Columns(Col): .Value = Evaluate("=IF(" & .Address & "="""",""-""," & .Address & ")"): End With
    Next i
    .RemoveDuplicates 1, xlYes
    For i = 1 To 3
        If i = 3 Then
            .AutoFilter ColArr(i), Array(CritArr(i), CritArr(i + 1)), xlFilterValues
        Else
            .AutoFilter ColArr(i), CritArr(i)
        End If
        If .Columns(1).SpecialCells(12).Cells.Count - 1 > 0 Then .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
    Next i
    Columns(38).Insert
     With .Columns("AL")
        .Cells(1) = "MD-Sub MD Name"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=IF(AJ2="""",AH2,AJ2)": .Value = .Value: End With
     End With
  End With
End With
    Sheets("Replace IMEI Process").Cells.ClearContents
    Sheets("RR IMEI Dump").UsedRange.Copy Sheets("Replace IMEI Process").Range("A1")
With Sheets("Replace IMEI Process").Activate
    With Sheets("Replace IMEI Process").Cells(1).CurrentRegion
        With .Columns(17)
        .Value = Evaluate("=If(Row(" & .Address & "),LEFT((" & .Address & "),10))")
        .NumberFormat = "DD-MMM-YYYY"
        End With
    .Sort .Cells(1, 17), xlAscending, , , , , , xlYes
    With .Columns(17)
        .AutoFilter 1, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        Sheets("Replace IMEI Process").Cells.Copy
        Sheets("Return IMEI").Cells.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.AutoFilterMode = False
        Application.CutCopyMode = False
    End With
End With
    
With Sheets("Act Data Process").Cells(1).CurrentRegion
        .Columns(3).Resize(, 2).Insert
    With .Columns("C:D")
        With .Offset(1).Resize(.Rows.Count - 1)
            .Formula = Array("=IFERROR(INDEX('Replace IMEI Process'!W:AA,MATCH(A2,'Replace IMEI Process'!V:V,0),5),"""")", "=IFERROR(INDEX('Return IMEI'!M:V,MATCH(A2,'Return IMEI'!V:V,0),10),""0"")")
            .Value = .Value
        End With
        .AutoFilter 1, "Completed"
        .AutoFilter 2, "0"
        If .Columns(1).SpecialCells(12).Cells.Count - 1 > 0 Then .Offset(1).SpecialCells(12).EntireRow.Delete
        .Parent.AutoFilterMode = False
    End With
   .Columns("AO").AutoFilter 1, ""
    If .Columns(1).SpecialCells(12).Cells.Count - 1 > 0 Then
        .Offset(1).Resize(.Rows.Count - 1).Columns("AS:AT").Value = "N/A"
    End If
    .Parent.AutoFilterMode = False
    .Range("B:F,H:I,L:Q,S:V,Z:AM,AQ:AQ,AU:BA").Delete
    .Columns(5).Resize(, 3).Insert
        With .Columns("E:G")
        .Cells(1).Resize(1, 3).Value = Array("Concat", "MOP", "DP")
        End With
    With .Columns(5).Resize(, 3).Offset(1).Resize(.Rows.Count - 1)
        .Formula = Array("=C2&D2", "=LOOKUP(2,1/(('Price List'!$B$2:B" & lr & "='Act Data Process'!E2)*('Price List'!$H$2:H" & lr & "<='Act Data Process'!I2)),'Price List'!$G$2:G" & lr & ")", "=LOOKUP(2,1/(('Price List'!$B$2:B" & lr & "='Act Data Process'!E2)*('Price List'!$H$2:H" & lr & "<='Act Data Process'!I2)),'Price List'!$F$2:F" & lr & ")")
        .Value = .Value
    End With
    With Sheets("Act Data Process").Activate
    With Sheets("Act Data Process").Cells(1).CurrentRegion
    Columns(6).Insert
    With .Columns("F")
        .Cells(1) = "Item Name"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=INDEX('Price List'!$K$2:K" & lr & ",MATCH('Act Data Process'!E2,'Price List'!$B$2:B" & lr & ",0))": .Value = .Value: End With
    End With
     Columns(3).Insert
    With .Columns("C")
        .Cells(1) = "Product Series"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=CONCAT(LEFT(D2),"" Series"")": .Value = .Value: End With
    End With
End With
End With
End With
    With Columns("B")
    .Replace What:="In Stock", Replacement:="App Pending", LookAt:=xlPart
    End With
    End With
    With Selection
    .NumberFormat = "General"
    .Value = .Value
    End With
    Columns("A:A").SpecialCells(xlCellTypeVisible).Select
    Selection.NumberFormat = "0"
With Sheets("Act Data Process").Activate
    With Sheets("Act Data Process").Cells(1).CurrentRegion
    With Columns("A:B")
    .Cells(1, "A").Value = "IMEI No."
    .Cells(1, "B").Value = "Business Status"
    End With
    With Columns("D:E")
    .Cells(1, "D").Value = "Product Model"
    .Cells(1, "E").Value = "Product Color"
    End With
    With Columns("J:M")
    .Cells(1, "J").Value = "Emp Name"
    .Cells(1, "K").Value = "Activation Date"
    .Cells(1, "L").Value = "Emp ID"
    .Cells(1, "M").Value = "Phone Type"
    End With
      With Columns("O:S")
    .Cells(1, "O").Value = "Retailer Code"
    .Cells(1, "P").Value = "Retailer Name"
    .Cells(1, "Q").Value = "Channel Type"
    .Cells(1, "R").Value = "Store Code"
    .Cells(1, "S").Value = "Store Name"
    End With
    .Columns(10).Resize(, 1).Insert
    With .Columns("J")
        .Cells(1) = "Price Range"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=IF(AND(H2>0,H2<10000),""Below 10K"",IF(AND(H2>10000,H2<15000),""10K to 15K"",IF(AND(H2>15000,H2<20000),""15K to 20K"",IF(AND(H2>20000,H2<25000),""20K to 25K"",IF(AND(H2>25000,H2<30000),""25K to 30K"",IF(AND(H2>30000,H2<100000),""Above 30K""))))))": .Value = .Value: End With
End With
    Columns(21).Insert
    With .Columns("U")
        .Cells(1) = "Activation Warehouse"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=IF(S2=""N/A"",""Distributor"",""Retailer"")": .Value = .Value: End With
    End With
    Columns(22).Insert
    With .Columns("V")
        .Cells(1) = "RSE"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=VLOOKUP(S2,'Sales Mapping'!A:AB,13,0)": .Value = .Value: End With
    End With
    Columns(23).Insert
    With .Columns("W")
        .Cells(1) = "RSO"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=VLOOKUP(S2,'Sales Mapping'!A:AB,15,0)": .Value = .Value: End With
    End With
    Columns(24).Insert
    With .Columns("X")
        .Cells(1) = "SIM"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=VLOOKUP(S2,'Sales Mapping'!A:AB,21,0)": .Value = .Value: End With
    End With
    Columns(25).Insert
    With .Columns("Y")
        .Cells(1) = "ASM"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=VLOOKUP(S2,'Sales Mapping'!A:AB,25,0)": .Value = .Value: End With
    End With
    Columns(11).Insert
    With .Columns("K")
        .Cells(1) = "Emp Name"
        With .Offset(1).Resize(.Rows.Count - 1): .Formula = "=TRIM(SplitCamelText(L2))": .Value = .Value: End With
    End With
  
    .Range("F:F,L:L").Delete
    .Font.Name = "Calibri"
    .Font.Size = 10
    .Columns.AutoFit
    End With
   End With
End Sub

 

[DacEasy]

Hmmm, try this, it may speed up the macro so you will not require a progress bar. Add Application.DisplayAlerts set to false below the top Sub Stage10 and above the End Sub set to true. See below:

Sub Stage1()
Application.DisplayAlerts = False




Application.DisplayAlerts =True
End Sub

 

[Pankaj Jaswani]

Thank you DacEasy for the responding on my post.

But, I'd like to see vba execution as a percentage completed in the progress bar. Please assist me in obtaining the code.

 

[Pankaj Jaswani]

Dear expert, please help me on this post.

 

[johnnyL]

@Pankaj Jaswani how many errors do you get when you run the code you provided.

What would you want to measure the progress of?

 

[Pankaj Jaswani]

@Pankaj Jaswani how many errors do you get when you run the code you provided.

What would you want to measure the progress of?

My code is working well; no issues have occurred. Also, I'd like to measure the coding that I've used in my code. I only want to show the entire "With...End with...With...End" statement coding process in the progress bar as a % completed.

 

[johnnyL]

Have a look here <---.

 

[GWteB]

For short-term tasks, you might consider using Excel's status bar.
If it's going to be a real progress bar, then you might be interested in this thread.