There are other things that can be toggled to make your macro work faster.

You may want to do something like:

Option Explicit
Sub testme()

Dim CalcMode As Long
Dim ViewMode As Long

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

'do the work--all that other stuff goes here.

'put things back to what they were
Application.Calculation = CalcMode
ActiveWindow.View = ViewMode

End Sub

blk&wht wrote:

Dave,

Yes that was it. Thanks again.

Still working on my other question.

Bob

"Dave Peterson" wrote:

If you turn calculation to manual, then run the macro, then turn calculation
back to automatic, is it quicker?

If yes, then add a line of code to change calc to manual at the top and a line
to change it back at the bottom.

blk&wht wrote:

Dave, This works great, but......

I made a few changes. I want it to start at U6 for the first set and AB6
for the second set. I changed mykeycol1st to U6 and mykeycol2nd to AB6.

Changed set Col1st .Range(.Cells(2 to a 6 and set Col2nd .Range(.cells(2 to
a 6 as well.

Changed iRow = 1 to iRow -= 6 so it will start at the correct row.

It now does what it is supposed to do where it is supposed to to it. It's
fast. I then changed the "sheet1" to my sheet name "bom". It works but it
is very slow. It takes about 20 seconds or so. What did I do wrong. Below
is the modified macro with your macro below that.

Bob

Sub testme()

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim Col1st As Range
Dim Col2nd As Range
Dim iRow As Long
Dim myCols1st As Long
Dim myCols2nd As Long
Dim myKeyCol1st As Long
Dim myKeyCol2nd As Long

Set wks = Worksheets("sheet1")
wks.DisplayPageBreaks = False
With wks
myKeyCol1st = .Range("u6").Column
myCols1st = 4 ' 4 columns associated with the 1st key

myKeyCol2nd = .Range("ab6").Column
myCols2nd = 4 '4 columns associated with the 2nd key

'row 5 has headers!
Set Col1st = .Range(.Cells(6, myKeyCol1st), _
.Cells(.Rows.Count, myKeyCol1st).End(xlUp))

Set Col2nd = .Range(.Cells(6, myKeyCol2nd), _
.Cells(.Rows.Count, myKeyCol2nd).End(xlUp))

With Col1st.Resize(, myCols1st)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

With Col2nd.Resize(, myCols2nd)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

iRow = 6
Do
If IsEmpty(.Cells(iRow, myKeyCol1st).Value) _
And IsEmpty(.Cells(iRow, myKeyCol2nd).Value) Then
Exit Do
End If

If .Cells(iRow, myKeyCol1st).Value _
= .Cells(iRow, myKeyCol2nd).Value _
Or IsEmpty(.Cells(iRow, myKeyCol1st).Value) _
Or IsEmpty(.Cells(iRow, myKeyCol2nd).Value) Then
'do nothing
Else
If .Cells(iRow, myKeyCol1st).Value _
.Cells(iRow, myKeyCol2nd).Value Then
.Cells(iRow, myKeyCol1st).Resize(1, myCols1st).Insert _
shift:=xlDown
Else
.Cells(iRow, myKeyCol2nd).Resize(1, myCols2nd).Insert _
shift:=xlDown
End If
End If
iRow = iRow + 1
Loop
End With

Application.ScreenUpdating = True

End Sub

"Dave Peterson" wrote:

So A:D are grouped together and E:H are grouped together?

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim Col1st As Range
Dim Col2nd As Range
Dim iRow As Long
Dim myCols1st As Long
Dim myCols2nd As Long
Dim myKeyCol1st As Long
Dim myKeyCol2nd As Long

Set wks = Worksheets("sheet1")
wks.DisplayPageBreaks = False
With wks
myKeyCol1st = .Range("a2").Column
myCols1st = 4 ' 4 columns associated with the 1st key

myKeyCol2nd = .Range("e2").Column
myCols2nd = 4 '4 columns associated with the 2nd key

'row 1 has headers!
Set Col1st = .Range(.Cells(2, myKeyCol1st), _
.Cells(.Rows.Count, myKeyCol1st).End(xlUp))

Set Col2nd = .Range(.Cells(2, myKeyCol2nd), _
.Cells(.Rows.Count, myKeyCol2nd).End(xlUp))

With Col1st.Resize(, myCols1st)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

With Col2nd.Resize(, myCols2nd)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

iRow = 2
Do
If IsEmpty(.Cells(iRow, myKeyCol1st).Value) _
And IsEmpty(.Cells(iRow, myKeyCol2nd).Value) Then
Exit Do
End If

If .Cells(iRow, myKeyCol1st).Value _
= .Cells(iRow, myKeyCol2nd).Value _
Or IsEmpty(.Cells(iRow, myKeyCol1st).Value) _
Or IsEmpty(.Cells(iRow, myKeyCol2nd).Value) Then
'do nothing
Else
If .Cells(iRow, myKeyCol1st).Value _
.Cells(iRow, myKeyCol2nd).Value Then
.Cells(iRow, myKeyCol1st).Resize(1, myCols1st).Insert _
shift:=xlDown
Else
.Cells(iRow, myKeyCol2nd).Resize(1, myCols2nd).Insert _
shift:=xlDown
End If
End If
iRow = iRow + 1
Loop
End With

Application.ScreenUpdating = True

End Sub

--

Dave Peterson


--

Dave Peterson