sort names based on alphabet doesn't work

leap out

Board Regular
Joined
Dec 4, 2020
Messages
110
Office Version
  1. 2016
  2. 2010
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
VBA Code:
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

Board Regular
Joined
Dec 4, 2020
Messages
110
Office Version
  1. 2016
  2. 2010
thanks again unfortunately, it gives me error "subscript out of range " in this line
VBA Code:
  Set VBComp = VBProj.VBComponents(moduleName)
 

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
Please Go to
Picture1.gif
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

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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
svn.gif
 

leap out

Board Regular
Joined
Dec 4, 2020
Messages
110
Office Version
  1. 2016
  2. 2010
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
VBA Code:
 .Sort.SortFields.Add2 Key:=KyRng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ''' or below
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Move ‘ to next up line
VBA Code:
           ‘.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
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,962
Office Version
  1. 365
Platform
  1. Windows
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:

The code:
VBA 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
 
Solution

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
PLZ Use this
VBA Code:
           .Sort.SortFields.Add2 Key:=.Columns(KyRng.Column), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ''' or below
 

Watch MrExcel Video

Forum statistics

Threads
1,127,601
Messages
5,625,749
Members
416,133
Latest member
ToseSenpai

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top