sort names based on alphabet doesn't work

[leap out]

hi
I have this macro doesn't work in cells a1 is dropdown I would sort based alphabet for instance if the list contains asd1,asd2,asd3 bbd,bdd1,bbb2 ,cdd,ccd,ccc
so should the list like this
asd1
asd2
asd3
bbb2
bbd1
bdd1
ccc
ccd
cdd
another thing I would when write in cells a1 manually for instance asd1 then show list
asd1
asd2
asd3

Sub Sort_B()
    With Sheets("sort").UsedRange
        .Sort Key1:=.Range("a1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    End With
End Sub

note: if is possible do the macro without button automatically

 

[leap out]

thanks again unfortunately, it gives me error "subscript out of range " in this line

  Set VBComp = VBProj.VBComponents(moduleName)

 

[Dossfm0q]

Please Go to

1-File > 2-Options >>3-Trust Center then on right Side click 4-Trust settings >> 5-Macro Settings finally check 6-Trust Access the VBA Project Object Module .

 

[Dossfm0q]

 

[leap out]

honestly , all of your suggestion are selected

 

[Dossfm0q]

copy into Worksheet Module and insert Compo Box from ActiveX Controls and Rename It "DropList" from Top Left function Bar Box as below Pic.

Private Sub DropList_Click()
    Dim DropList As OLEObject
    On Error Resume Next
        Set DropList = Me.OLEObjects("DropList")
            With DropList
            .Visible = False
            End With
    On Error GoTo 0

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KyRng As Range, SrtRng As Range
Dim LstRw As Long
    If Not Intersect(Target, Columns(1)) Is Nothing Then
    With Target.Parent
        LstRw = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        Set KyRng = .Cells(1, 1).Resize(LstRw, 1)
        Set SrtRng = .Cells(2, 1).Resize(LstRw, 1)
           .Sort.SortFields.Clear
           .Sort.SortFields.Add2 Key:=KyRng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ''' or below
           '.Sort.SortFields.Add2 Key:=Range("A1:A50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          
           With .Sort
               .SetRange SrtRng ''' or below
               '.SetRange Range("A2:50")
               .Header = xlNo
               .MatchCase = False
               .Orientation = xlTopToBottom
               .SortMethod = xlPinYin
               .Apply
           End With
    End With
    Else
    
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim DropList As OLEObject
    On Error Resume Next
    Application.EnableEvents = False
    If Not Intersect(Target, Range("B2:E100")) Is Nothing Then
     Set DropList = Target.Parent.OLEObjects("DropList")
        With DropList
           .Left = Target.Left
           .Top = Target.Top
           .Width = Target.Width
           .Height = Target.Height
           .LinkedCell = Target.Address(True, True)
           .Visible = True
        End With
    Else
    
    End If
    Application.EnableEvents = True
    On Error GoTo 0

End Sub

 

[leap out]

sorry I appreciate your assistance , but when I change in column a it shows error "object doesn't support this property or method" in this line

 .Sort.SortFields.Add2 Key:=KyRng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ''' or below

 

[Dossfm0q]

Move ‘ to next up line

           ‘.Sort.SortFields.Add2 Key:=KyRng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ''' or below
           .Sort.SortFields.Add2 Key:=Range("A1:A50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 

[leap out]

unfortunately nothing changes

 

[Akuini]

Hi @leap out

another thing I would when write in cells a1 manually for instance asd1 then show list
asd1
asd2
asd3

Data validation doesn't have searchable feature. If you're ok to use activex combobox, here's an example:

deCombobox - sheet,1 cell, searchable,filter,sort - example 1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

The code:

Option Explicit
'=============== YOU MAY NEED TO ADJUST THE CODE IN THIS PART: ===================================

'sheet's name where the list (for combobox) is located. [in the sample: sheet "deList"]
Private Const sList As String = "deList"

'cell where the list start [in the sample: cell A2 in sheet "deList" ]
Private Const sCell As String = "A2"

'the linked cell (cell that link to the combobox)
Private Const xCell As String = "B3"

Private vList
Private c As Range


Private Sub ComboBox1_Change()
Dim z, ary

With ComboBox1
    If .Value <> "" And IsError(Application.Match(.Value, vList, 0)) Then
        With Sheets(sList)
            ary = Application.Transpose(c.Value)
        End With
               
                For Each z In Split(.Value, " ")
                    ary = Filter(ary, z, True, vbTextCompare)
                Next
           .List = ary
           .DropDown
   
    ElseIf Not IsError(Application.Match(.Value, vList, 0)) Then
        Range(xCell) = .Value
   
    Else
        Range(xCell) = .Value
        .List = vList
    End If
End With
End Sub


Private Sub ComboBox1_GotFocus()
With Sheets(sList)
    Set c = .Range(sCell, .Cells(.Rows.Count, .Range(sCell).Column).End(xlUp))
    c.Sort Key1:=.Range(sCell), Order1:=xlAscending, Header:=xlNo
    vList = Application.Transpose(c.Value)
End With

    ComboBox1.MatchEntry = fmMatchEntryNone
    ComboBox1.Value = ""
    'ComboBox1.ListRows = 10 'to show how many item
End Sub

 

[Dossfm0q]

PLZ Use this

           .Sort.SortFields.Add2 Key:=.Columns(KyRng.Column), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ''' or below