I have the following macro which runs perfectly, finishing in 4 seconds (so long as "Application.Calculation = xlAutomatic" is removed). Calculation is necessary but turns 4 seconds into 23 minutes. Any suggestions?
Sub GreaterThan17k()
'
' GreaterThan17k Macro
'
Range("R2").Select
Selection.Copy
Range("S2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.EnableEvents = False
Range("R2,T2:T27,U2:U11,V2:W5,U41:U3880").Select
Range("U41").Activate
Application.CutCopyMode = False
Selection.ClearContents
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Range("B41:BF182").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.CLEAR
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"R41:R3880"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B41:BF3880")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
Range("S2").Select
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
Application.CutCopyMode = False
Selection.Copy
Range("T2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R10").Select
Application.CutCopyMode = False
Selection.Copy
Range("T3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AU41:AU64").Select
Range("AU64").Activate
Application.CutCopyMode = False
Selection.Copy
Range("T4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R19").Select
Application.CutCopyMode = False
Selection.Copy
Range("U2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q10").Select
Application.CutCopyMode = False
Selection.Copy
Range("U3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AT41:AT48").Select
Range("AT48").Activate
Application.CutCopyMode = False
Selection.Copy
Range("U4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q19").Select
Application.CutCopyMode = False
Selection.Copy
Range("V2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P10").Select
Application.CutCopyMode = False
Selection.Copy
Range("V3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("V2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AS41:AS42").Select
Range("AS42").Activate
Application.CutCopyMode = False
Selection.Copy
Range("V4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P19").Select
Application.CutCopyMode = False
Selection.Copy
Range("W2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P10").Select
Application.CutCopyMode = False
Selection.Copy
Range("W3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AS41:AS42").Select
Range("AS42").Activate
Application.CutCopyMode = False
Selection.Copy
Range("W4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
Range("BG14").Select
Selection.Copy
Range("BI12").Select
ActiveSheet.Paste
MsgBox "THERE MAY BE SUGGESTED SHARES TO UTILIZE UNALLOCATED FUNDS. ADD ADDITIONAL SHARES NOW."
End Sub
