VBA array to sort and display information

[dimsums]

Hi all,
I have a sheet with information and i use the sort method to display the information i would like to see on top. This works for a few but sometimes displays the sort results in rows 2000 onwards instead of displaying it on top.
Could someone help me see why?

Sub ofinumber()
'
' ofinumber Macro
'

'
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-18
Range("Cf5").Select
Selection.Copy
Range("k1").Select
ActiveSheet.Paste
Range("A3:AP2774").Select
Application.DeleteCustomList ListNum:=11
Application.AddCustomList ListArray:=Array("OFI", ".", "PI", "6S", "HS", "NC", "CC" _
, "SF", "MAINT")
ActiveWorkbook.Worksheets("All OFIs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("All OFIs").Sort.SortFields.Add Key:=Range( _
"G3:G2774"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"OFI,.,MS,6S,HS,NC,CC,SF,MAINT", DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("All OFIs").Sort.SortFields.Add Key:=Range( _
"a3:a2774"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("All OFIs").Sort.SortFields.Add Key:=Range( _
"E3:E2774"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("All OFIs").Sort
.SetRange Range("A2:AP2774")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.ScrollRow = 3
Rows("3:2774").Select
Rows("3:2774").EntireRow.AutoFit
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
End Sub

 

[DanteAmor]

Try this:

Sub ofinumber()
  Dim arr As Variant
  Dim lr As Long
  Dim sh As Worksheet
  
  Set sh = ActiveWorkbook.Worksheets("All OFIs")
  arr = Array("OFI", ".", "PI", "6S", "HS", "NC", "CC", "SF", "MAINT")
  Application.DeleteCustomList ListNum:=11
  Application.AddCustomList ListArray:=arr
  
  Range("CF5").Copy Range("K1")
  lr = Range("A" & Rows.Count).End(3).Row
  
  With sh.Sort
    .SortFields.Clear
  
    .SortFields.Add Key:=sh.Range("G3:G" & lr), SortOn:=0, Order:=1, CustomOrder:=Join(arr, ","), DataOption:=0
    .SortFields.Add Key:=sh.Range("A3:A" & lr), SortOn:=0, Order:=1, DataOption:=0
    .SortFields.Add Key:=sh.Range("E3:E" & lr), SortOn:=0, Order:=1, DataOption:=0
    
    .SetRange sh.Range("A2:AP" & lr)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  
  sh.Rows("3:" & lr).EntireRow.AutoFit
  sh.Range("A" & lr).Select
End Sub

 

[dimsums]

Thanks Dante,
I also realised that my referencing was off and that fixed the code.
Thank you for your help!

 

[DanteAmor]

Well there you have an improved code for your consideration.