Sort function does not correctly reference the answer from the input box.

Use Application.Inputbox, with Type:=8

On Error Resume Next
Set rng = Application.Inputbox("Select range",Type:=8)
If Not rng Is Nothing Then
rng.Sort
'etc.

TRy setting it up this way.

LeapingLizard I am not understanding your advice, sorry. I am a novice with VBA.

To clarify, I am attempting to sort data from left-to-right based upon row2 using a dynamic value which is entered by the user through the input box. The issue is linking the answer from the input box to the custom sort.

I can do this sorting manually but I need to incorporate this into a larger macro which can handle many operations.

The issue is designating the "Answer" in the sort criteria. I am unsure of the format. See below.

Answer = Application.InputBox("Please enter sort criteria", "Sort")

Range("A1").Select
                
  
  ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:XFD2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        Answer, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

If for example I use the following, the macro runs with no issues.

  ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:XFD2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "GGG", DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

The problem is the turning the format "GGG" into the 'Answer'.

Thanks!

Can you provide a sample workbook with data and your sort macro (the one that works and the one you are trying)?

Please also explain what you are trying to achieve with the CustomOrder

Hello Jeff,

Thank you for your assistance.


This is the code that works.

Sub A_Test()

  ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:XFD2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "GGG", DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

This is the code that does not work.

Sub A_Test()

Answer = Application.InputBox("Please enter sort criteria", "Sort")
  ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:XFD2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        Answer, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I want to sort all the columns based upon Row2 using a custom sort of "GGG". I know I can do this manually but this is one part of a much larger macro which I am putting together.

After several several attempts to find a solution I just could not. I placed a message with the other forum members, but not luck so far.

Once you see this, if there still is not a hit you can bump again.

perhaps

Sub A_Test2()
    Dim Answer
    Answer = Application.InputBox("Please enter sort criteria", "Sort")
    Application.AddCustomList Array(Answer)
    With ActiveSheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("A2:XFD2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                 CustomOrder:=Application.CustomListCount, DataOption:=xlSortNormal
        End With
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.DeleteCustomList Application.CustomListCount
End Sub