VBA Custom Sort Order Issues

Not sure (there's a lot going on) but try the following:
in the macro "Sub Sort()" adapt these lines

For i = 0 To 21
                If Con(i, 1) <> wSheet.Name And Con(i, 1) <> "" Then SortOrder = SortOrder & "," & Con(i, 1)
            Next i

and

ActiveWorkbook.Worksheets(wSheet.Name).Sort.SortFields.Add Key:=Range("B4:B69"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
            CStr(SortOrder), DataOption:=xlSortNormal