Can anyone tell me why this code runs correctly then crashes Excel and loses the changes please. I have used same code on other workbooks and without an y problems!

Thank you


Private Sub CommandButton1_Click()Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("SIT")
Dim oRangeSort As Range
Dim oRangeKey As Range

' one range that includes all colums do sort
Set oRangeSort = oWorksheet.Range("A10:H200")
' start of column with keys to sort
Set oRangeKey = oWorksheet.Range("G10")

' custom sort order
Dim sCustomList(1 To 4) As String
sCustomList(1) = "RED"
sCustomList(2) = "AMBER"
sCustomList(3) = "YELLOW"
sCustomList(4) = "GREEN"

Application.AddCustomList ListArray:=sCustomList
' use this if you want a list on the spreadsheet to sort by
' Application.AddCustomList ListArray:=Range("D1:D3")

oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

' clean up
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing
End Sub