Adding a progress bar is quite complex, not the progress bar per se, but
creating intercept points in the code where the progress bar is invoked (and
it will slow your code down).

First, see if we can speed it up.

Sub Macro1()
Dim myCell As Range
Dim row As Long, i As Long
Dim iLastRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False

Range("A:J").Sort Key1:=Range("A2"), order1:=xlAscending, header:=xlNo
Range("L:R").Sort Key1:=Range("L2"), order1:=xlAscending, header:=xlNo

iLastRow = Application.Max(Cells(Rows.Count, "A").End(xlUp).row, _
Cells(Rows.Count, "L").End(xlUp).row)
For row = iLastRow To 1 Step -1

If Cells(row, 12).Value < Cells(row, 1).Value And _
Cells(row, 1).Value < Cells(row, 12).Value Then
Cells(row, 12).Resize(7).Insert Shift:=xlDown
ElseIf Cells(row, 1).Value < Cells(row, 12).Value And _
Cells(row, 12).Value < Cells(row, 1).Value Then
Cells(row, 2).Resize(9).Insert Shift:=xlDown
End If

Next row

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.DisplayPageBreaks = True

End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"malycom" wrote in message
...
Hi all and Happy New Year to you.

I have a spreadsheet which compares to sets of data and aligns them
correctly. This works fine but it takes a long time to run as there are
1500
rows there about.

THis is the code
===========================================
Sub Macro1()
Dim myCell As Range
Dim row As Long, i As Long

Range("A:J").Sort Key1:=Range("A2"), order1:=xlAscending, header:=xlNo
Range("L:R").Sort Key1:=Range("L2"), order1:=xlAscending, header:=xlNo
row = 1
Do Until IsEmpty(Cells(row, "A")) And IsEmpty(Cells(row, "L"))

If Cells(row, 12).Value < Cells(row, 1).Value And Cells(row, 1).Value <
Cells(row, 12).Value Then
Cells(row, 12).Insert Shift:=xlDown
Cells(row, 13).Insert Shift:=xlDown
Cells(row, 14).Insert Shift:=xlDown
Cells(row, 15).Insert Shift:=xlDown
Cells(row, 16).Insert Shift:=xlDown
Cells(row, 17).Insert Shift:=xlDown
Cells(row, 18).Insert Shift:=xlDown
Else
If Cells(row, 1).Value < Cells(row, 12).Value And Cells(row, 12).Value <
Cells(row, 1).Value Then
Cells(row, 2).Insert Shift:=xlDown
Cells(row, 3).Insert Shift:=xlDown
Cells(row, 4).Insert Shift:=xlDown
Cells(row, 5).Insert Shift:=xlDown
Cells(row, 6).Insert Shift:=xlDown
Cells(row, 7).Insert Shift:=xlDown
Cells(row, 8).Insert Shift:=xlDown
Cells(row, 9).Insert Shift:=xlDown
Cells(row, 10).Insert Shift:=xlDown
End If
End If
row = row + 1
Loop
End Sub

================================================== =
Question 1: Can someone tell me how I can add some form of progress bar or
visual aid that will tell me the process completed at any point during
running the application.

Question 2: Is there a quicker way to achieve the above code. (Question 1
is more important unless question 2 is achieved easily)

Please note, the code I use was from this community in the first place so
I
will need detailed explanations on how to achieve either of the above
questions. I am not a coder and rely on the bright people out there for
help
with this type of stuff.

This community has answered every single question I have asked in the past
and I am in no doubt that I will get the answer for this so thanks in
advance
for all who reply.

Kind regards

Malcolm