Can I stop it Jumping?

[DUI]

Hi Guys,

The following code was created by alot of recording and cut & pasting...
The trouble is, even using screenupdating = false, you can see the code run.
Can anyone see any improvements?
I had to use the unlock method a few times as there is more code using Worksheet_Change & Worksheet_SelectionChange causing it to lock halfway thru.



Sub SalesLogReset()

Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("H13").FormulaR1C1 = "Pay"
Range("K13").FormulaR1C1 = "S/P"


'Change Buttons
ActiveSheet.Unprotect
ActiveSheet.Shapes("Text Box 4604").Select
Selection.Font.ColorIndex = 55
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44


ActiveSheet.Shapes("Text Box 442").Select
Selection.Font.ColorIndex = 56
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12


ActiveSheet.Shapes("Text Box 443").Select
Selection.Font.ColorIndex = 55
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44



'Reformat & Sort
Range("G:G,H:H,I:I,J:J,K:K,L:L,P:P,R:R,S:S,AA:AA,AB:AB,AE:AE,AF:AF,AI:AI,AJ:AJ,AK:AK").EntireColumn.Hidden = False
Range("T:T,U:U,Y:Y,Z:Z,AG:AG,AH:AH").EntireColumn.Hidden = True

Range("B13:AL400").Sort Key1:=Range("J14"), Order1:=xlAscending, Key2:=Range("G14" _
), Order2:=xlAscending, Key3:=Range("K14"), Order3:=xlAscending, Header _
:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Rows("8:11").EntireRow.Hidden = False
Rows("4:7").EntireRow.Hidden = True



'Renew salespeople
Range("AY17:AY411").ClearContents
ActiveSheet.Unprotect
Range("K13:K400").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("AY15:AY16"), CopyToRange:=Range("AY17"), Unique:=True



'Print Setup
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.PrintArea = "$G$8:$AF$400"
Range("F14").Activate

ActiveSheet.Protect
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Application.ScreenUpdating = True

End Sub