VBA progress indicator on Status Bar

Alexandru Dan Mitache

Alexandru Dan Mitache

New Member
Joined
Oct 19, 2020
Messages
18
Office Version
  1. 365
Platform
  1. Windows
Hello, All!
I would like to have not a progress bar made with User Form, but a simple percentage counter (from 0% to 100%) on the Status Bar, showing the execution of each line in a 600 lines long macro, with no loops.
I found the solution below, but I don't know how to use it, or if it works in my case.
Thank you! Have a great day/evening!

Dim x As Integer
Dim MyTimer As Double

'Change this loop as needed.
For x = 1 To 250

'Dummy Loop here just to waste time.
'Replace this loop with your actual code.
MyTimer = Timer
Do
Loop While Timer - MyTimer < 0.03

Application.StatusBar = "Progress: " & x & " of 250: " & Format(x / 250, "Percent")
DoEvents

Next x

Application.StatusBar = False
 
Sort by date Sort by votes
It helps enormously if you post your current code (remember to use CODE tags. Apply tags by first pressing the "VBA" button at the top of the post editing box and then pressing control V to paste your code).
 
Upvote 0
jkpieterse said:
It helps enormously if you post your current code (remember to use CODE tags. Apply tags by first pressing the "VBA" button at the top of the post editing box and then pressing control V to paste your code).
Click to expand...
VBA Code: 
Sub Macro_ACTUALIZARE_SCADENTAR()
'
' Macro_ACTUALIZARE_SCADENTAR Macro
'
'>>> INTRO
    Application.WindowState = xlMaximized
    Application.StatusBar = False
    Application.StatusBar = "ASTEPTATI... Se actualizeaza SCADENTARUL. Dureaza circa 30 de secunde..."
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Dim StartTime As Double
        Dim SecondsElapsed As Double
'Remember time when macro starts
            StartTime = Timer
'
    Workbooks.Open Filename:= _
        "C:\Users\Alexandru\Desktop\SCADENTAR\EXPORT SCADENTAR SOFT1 NOU.xlsx"
    Cells.Select
    Range("A1").Activate
    Selection.Copy
    Windows("SCADENTAR CLIENTI (Macro Soft1).xlsm").Activate
    Sheets("INCASARI PARTIALE").Select
    Cells.Select
    ActiveSheet.Paste
    Cells.Select
    Selection.RemoveSubtotal
    Windows("EXPORT SCADENTAR SOFT1 NOU.xlsx").Activate
    Range("A1").Select
    ActiveWorkbook.Close
    Cells.Select
    Selection.UnMerge
    Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    Columns("B:B").Select
    Selection.Replace What:="A/A", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-9])=TRUE,"""",RC[-9])"
    Selection.Copy
    Range("K2:K5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISTEXT(RC[-9])=TRUE,RC[-9],R[-1]C)"
    Selection.Copy
    Range("K2:K5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("B1:B5000").Select
    Selection.Replace What:="", Replacement:="XXX", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="XXX", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("K2:K5000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("K:K").Select
    Selection.ClearContents
    Range("K2").Select
    Workbooks.Open Filename:= _
        "C:\Users\Alexandru\Desktop\SCADENTAR\LISTA CLIENTI-AGENTI-TERMEN-STARE.xlsm"
    Application.WindowState = xlMaximized
    Windows("LISTA CLIENTI-AGENTI-TERMEN-STARE.xlsm").Activate
    ActiveWindow.WindowState = xlNormal
    Application.Goto Reference:="R3C1"
    Windows("SCADENTAR CLIENTI (Macro Soft1).xlsm").Activate
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-9]="""","""",VLOOKUP(RC[-9],'[LISTA CLIENTI-AGENTI-TERMEN-STARE.xlsm]LISTA CLIENTI'!R3C2:R5000C70,69,FALSE))"
    Selection.Copy
    Range("K2:K5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0000.0000"
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("K:K").Select
    Selection.ClearContents
    Columns("G:I").Select
    Selection.NumberFormat = "#,##0.00"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-8])=TRUE,RC[-10],"""")"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-9])=TRUE,RC[-10],"""")"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-10])=TRUE,RC[-10],"""")"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-11])=TRUE,RC[-8],"""")"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-12])=TRUE,RC[-8],"""")"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-13])=TRUE,RC[-8],"""")"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-14])=TRUE,RC[-8],"""")"
    Range("K2:Q2").Select
    Selection.Copy
    Range("K2:Q5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("K:Q").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:J").Select
    Range("J1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.NumberFormat = "0000.0000"
    Columns("C:C").Select
    Selection.NumberFormat = "dd-mm-yyyy;@"
    Columns("E:G").Select
    Selection.NumberFormat = "#,##0.00"
    Range("C:C,A:A").Select
    Range("A1").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1:G5000").Select
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("A1:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("C1:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("D1:D5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort
        .SetRange Range("A1:G5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    Columns("A:A").ColumnWidth = 10
    Columns("B:B").Select
    Selection.ColumnWidth = 55
    Columns("C:C").Select
    Selection.ColumnWidth = 9
    Columns("D:D").Select
    Selection.ColumnWidth = 12
    Columns("E:G").Select
    Selection.ColumnWidth = 10
    Range("H1").Select
    ActiveCell.Formula2R1C1 = _
        "=TEXTJOIN("""",TRUE,IFERROR(MID(RC[-4],SEQUENCE(20),1)+0,""""))"
    Selection.Copy
    Application.CutCopyMode = False
    ActiveCell.Formula2R1C1 = _
        "=IF(RC[-7]="""","""",TEXTJOIN("""",TRUE,IFERROR(MID(RC[-4],SEQUENCE(20),1)+0,"""")))"
    Selection.Copy
    Range("H1:H5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("D:D").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("H1").Select
    Sheets("INCASARI PARTIALE").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-4],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Selection.Copy
    Range("H1:H5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("H1").Select
    Application.CutCopyMode = False
    Range("I1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-5],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-6],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-7],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-8],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-9],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-10],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("I1:N1").Select
    Selection.Copy
    Range("I1:N5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("H:N").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Columns("A:G").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:N").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1:G5000").Select
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("A1:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("C1:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("D1:D5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort
        .SetRange Range("A1:G5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-7]="""","""",VLOOKUP(RC[-7],Sheet1!R2C4:R5000C8,5,FALSE))"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-7]="""","""",VLOOKUP(RC[-4],Sheet1!R2C4:R5000C8,5,FALSE))"
    Selection.Copy
    Range("H1:H5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("I1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-8]="""","""",ROUND(RC[-1],2)-ROUND(RC[-2],2))"
    Selection.Copy
    Range("I1:I5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("J1").Select
    Sheets("SCADENTAR TOTAL").Select
    Range("Z2").Select
'>>>>>>>>>>>>>
    Application.Goto Reference:="R2C26"
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-23]="""","""",IF(ISERROR(MATCH(RC[-23],'INCASARI PARTIALE'!R1C4:R5000C4,0))=TRUE,RC[-19],IF(RC[-12]>VLOOKUP(RC[-23],'INCASARI PARTIALE'!R1C4:R5000C9,6,FALSE),RC[-12],VLOOKUP(RC[-23],'INCASARI PARTIALE'!R1C4:R5000C9,6,FALSE))))"
    Selection.Copy
    Range("Z2:Z5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.Goto Reference:="R2C26"
    ActiveWindow.LargeScroll Down:=3
    ActiveWindow.LargeScroll ToRight:=-1
    Application.Goto Reference:="R2C26"
    Range("Z2:Z5000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="", Replacement:="XXX", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="XXX", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False
    Selection.Copy
    Application.Goto Reference:="R2C14"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Z:Z").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Application.Goto Reference:="R2C1"
    Application.Goto Reference:="R1C1"

    Range("M:M,N:N,Q:Q,M1,N1,Q1").Select

    Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="#REF!", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.Goto Reference:="R2C1"
    Application.Goto Reference:="R1C1"

    Range("N2:N5000,M2:M5000,Q2:Q5000").Select
    Selection.Replace What:="", Replacement:="XXX", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="XXX", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False

    Range("A1").Select
    Sheets("INCASARI PARTIALE").Select
    Columns("H:I").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "#,##0.00"
    Range("A1").Select
    Sheets("SCADENTAR TOTAL").Select
    Range("M:M,N:N,Q:Q").Select
    Selection.NumberFormat = "#,##0.00"

     Range("N2:N5000").Select
     Application.CutCopyMode = False
     Selection.Copy
     Range("Q2:Q5000").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False

    Application.Goto Reference:="R2C1"
    Range("A1").Select

    Sheets("Lansare Macrouri").Select
'>>> FINISH
       Sheets("Lansare Macrouri").Select
        Range("A1").Select
        SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
    MsgBox "SCDAENTARUL a fost actualizat in " & SecondsElapsed & " secunde. Nu uitati sa salvati!", vbInformation
    Application.StatusBar = "Actualizarea Scadentarului s-a incheiat!"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Sub Macro_ACTUALIZARE_SCADENTAR()
'
' Macro_ACTUALIZARE_SCADENTAR Macro
'
'>>> INTRO
    Application.WindowState = xlMaximized
    Application.StatusBar = False
    Application.StatusBar = "ASTEPTATI... Se actualizeaza SCADENTARUL. Dureaza circa 30 de secunde..."
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Dim StartTime As Double
        Dim SecondsElapsed As Double
'Remember time when macro starts
            StartTime = Timer
'
    Workbooks.Open Filename:= _
        "C:\Users\Alexandru\Desktop\SCADENTAR\EXPORT SCADENTAR SOFT1 NOU.xlsx"
    Cells.Select
    Range("A1").Activate
    Selection.Copy
    Windows("SCADENTAR CLIENTI (Macro Soft1).xlsm").Activate
    Sheets("INCASARI PARTIALE").Select
    Cells.Select
    ActiveSheet.Paste
    Cells.Select
    Selection.RemoveSubtotal
    Windows("EXPORT SCADENTAR SOFT1 NOU.xlsx").Activate
    Range("A1").Select
    ActiveWorkbook.Close
    Cells.Select
    Selection.UnMerge
    Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    Columns("B:B").Select
    Selection.Replace What:="A/A", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-9])=TRUE,"""",RC[-9])"
    Selection.Copy
    Range("K2:K5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISTEXT(RC[-9])=TRUE,RC[-9],R[-1]C)"
    Selection.Copy
    Range("K2:K5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("B1:B5000").Select
    Selection.Replace What:="", Replacement:="XXX", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="XXX", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("K2:K5000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("K:K").Select
    Selection.ClearContents
    Range("K2").Select
    Workbooks.Open Filename:= _
        "C:\Users\Alexandru\Desktop\SCADENTAR\LISTA CLIENTI-AGENTI-TERMEN-STARE.xlsm"
    Application.WindowState = xlMaximized
    Windows("LISTA CLIENTI-AGENTI-TERMEN-STARE.xlsm").Activate
    ActiveWindow.WindowState = xlNormal
    Application.Goto Reference:="R3C1"
    Windows("SCADENTAR CLIENTI (Macro Soft1).xlsm").Activate
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-9]="""","""",VLOOKUP(RC[-9],'[LISTA CLIENTI-AGENTI-TERMEN-STARE.xlsm]LISTA CLIENTI'!R3C2:R5000C70,69,FALSE))"
    Selection.Copy
    Range("K2:K5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0000.0000"
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("K:K").Select
    Selection.ClearContents
    Columns("G:I").Select
    Selection.NumberFormat = "#,##0.00"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-8])=TRUE,RC[-10],"""")"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-9])=TRUE,RC[-10],"""")"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-10])=TRUE,RC[-10],"""")"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-11])=TRUE,RC[-8],"""")"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-12])=TRUE,RC[-8],"""")"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-13])=TRUE,RC[-8],"""")"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-14])=TRUE,RC[-8],"""")"
    Range("K2:Q2").Select
    Selection.Copy
    Range("K2:Q5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("K:Q").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:J").Select
    Range("J1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.NumberFormat = "0000.0000"
    Columns("C:C").Select
    Selection.NumberFormat = "dd-mm-yyyy;@"
    Columns("E:G").Select
    Selection.NumberFormat = "#,##0.00"
    Range("C:C,A:A").Select
    Range("A1").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1:G5000").Select
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("A1:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("C1:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("D1:D5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort
        .SetRange Range("A1:G5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    Columns("A:A").ColumnWidth = 10
    Columns("B:B").Select
    Selection.ColumnWidth = 55
    Columns("C:C").Select
    Selection.ColumnWidth = 9
    Columns("D:D").Select
    Selection.ColumnWidth = 12
    Columns("E:G").Select
    Selection.ColumnWidth = 10
    Range("H1").Select
    ActiveCell.Formula2R1C1 = _
        "=TEXTJOIN("""",TRUE,IFERROR(MID(RC[-4],SEQUENCE(20),1)+0,""""))"
    Selection.Copy
    Application.CutCopyMode = False
    ActiveCell.Formula2R1C1 = _
        "=IF(RC[-7]="""","""",TEXTJOIN("""",TRUE,IFERROR(MID(RC[-4],SEQUENCE(20),1)+0,"""")))"
    Selection.Copy
    Range("H1:H5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("D:D").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("H1").Select
    Sheets("INCASARI PARTIALE").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-4],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Selection.Copy
    Range("H1:H5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("H1").Select
    Application.CutCopyMode = False
    Range("I1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-5],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-6],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-7],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-8],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-9],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MATCH(RC[-10],Sheet1!R2C4:R5000C4,0))=TRUE,"""",RC[-7])"
    Range("I1:N1").Select
    Selection.Copy
    Range("I1:N5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("H:N").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Columns("A:G").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:N").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1:G5000").Select
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("A1:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("C1:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort.SortFields.Add2 Key:= _
        Range("D1:D5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("INCASARI PARTIALE").Sort
        .SetRange Range("A1:G5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-7]="""","""",VLOOKUP(RC[-7],Sheet1!R2C4:R5000C8,5,FALSE))"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-7]="""","""",VLOOKUP(RC[-4],Sheet1!R2C4:R5000C8,5,FALSE))"
    Selection.Copy
    Range("H1:H5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("I1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-8]="""","""",ROUND(RC[-1],2)-ROUND(RC[-2],2))"
    Selection.Copy
    Range("I1:I5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("J1").Select
    Sheets("SCADENTAR TOTAL").Select
    Range("Z2").Select
'>>>>>>>>>>>>>
    Application.Goto Reference:="R2C26"
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-23]="""","""",IF(ISERROR(MATCH(RC[-23],'INCASARI PARTIALE'!R1C4:R5000C4,0))=TRUE,RC[-19],IF(RC[-12]>VLOOKUP(RC[-23],'INCASARI PARTIALE'!R1C4:R5000C9,6,FALSE),RC[-12],VLOOKUP(RC[-23],'INCASARI PARTIALE'!R1C4:R5000C9,6,FALSE))))"
    Selection.Copy
    Range("Z2:Z5000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.Goto Reference:="R2C26"
    ActiveWindow.LargeScroll Down:=3
    ActiveWindow.LargeScroll ToRight:=-1
    Application.Goto Reference:="R2C26"
    Range("Z2:Z5000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="", Replacement:="XXX", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="XXX", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False
    Selection.Copy
    Application.Goto Reference:="R2C14"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Z:Z").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Application.Goto Reference:="R2C1"
    Application.Goto Reference:="R1C1"

    Range("M:M,N:N,Q:Q,M1,N1,Q1").Select

    Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="#REF!", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.Goto Reference:="R2C1"
    Application.Goto Reference:="R1C1"

    Range("N2:N5000,M2:M5000,Q2:Q5000").Select
    Selection.Replace What:="", Replacement:="XXX", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="XXX", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Application.CutCopyMode = False

    Range("A1").Select
    Sheets("INCASARI PARTIALE").Select
    Columns("H:I").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "#,##0.00"
    Range("A1").Select
    Sheets("SCADENTAR TOTAL").Select
    Range("M:M,N:N,Q:Q").Select
    Selection.NumberFormat = "#,##0.00"

     Range("N2:N5000").Select
     Application.CutCopyMode = False
     Selection.Copy
     Range("Q2:Q5000").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False

    Application.Goto Reference:="R2C1"
    Range("A1").Select

    Sheets("Lansare Macrouri").Select
'>>> FINISH
       Sheets("Lansare Macrouri").Select
        Range("A1").Select
        SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
    MsgBox "SCDAENTARUL a fost actualizat in " & SecondsElapsed & " secunde. Nu uitati sa salvati!", vbInformation
    Application.StatusBar = "Actualizarea Scadentarului s-a incheiat!"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
Since your code doesn't seem to contain any loops, I would simply insert lines like this one at strategic places:
VBA Code: 
Application.Statusbar = "Step 1 of XXX,  Copying data"
Remeber to end your macro with this:
VBA Code: 
Application.Statusbar = False
so the status bar is returned to its usual self.
 
Upvote 0
jkpieterse said:
Since your code doesn't seem to contain any loops, I would simply insert lines like this one at strategic places:
VBA Code: 
Application.Statusbar = "Step 1 of XXX,  Copying data"
Remeber to end your macro with this:
VBA Code: 
Application.Statusbar = False
so the status bar is returned to its usual self.
Click to expand...
Thank you, Jan!
It's not exactly what I wanted, but your idea is good enough for my purpose.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
vba to send calendar appointments rather then emails
Replies
1
Views
728
Tej92
T
G
  • Solved
VBA display progress (e.g. in status bar) for huge iteration
Replies
3
Views
5K
Akuini
Akuini
A
  • Solved
VBA Help!
Replies
2
Views
484
AusNewb
A
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
P
  • Question Question
Conflicting Codes Help Please
Replies
2
Views
607
pure vito
P

Forum statistics

Threads
1,226,771
Messages
6,192,917
Members
453,766
Latest member
Gskier

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top