Hi
I have a combo box which functions as an autocomplete using data validation against a list of members of an organisation. It forms part of a booking form, so that when people book for an event, they can be easily added to a booking list.
I have some code in the Worksheet_SelectionChange Sub which both does the validation, and then sorts the data into alphabetical order...
Its working great, except for one thing: Entering the first entry on row B2, with a header being allowed in the Sort. function so that the header is not included, the entry subsequently appears in cell B25!! If I then enter a second entry, it sorts alphabetically up from there, so the next entry, if alphabetically above will appear at B24, or if alphabetically below, the first entry will shift to B24 and the new entry replace it at B25.
If I change the Order1:=xlAscending to xlDescending it solves the issue, but then I have alphabetical sorting from Z - A which is not what I want at all!
Can anyone help? What have I done wrong?
Here is the code for the SelectionChange sub:
==================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim alpharng As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Set alpharng = Columns("B:B")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set cboTemp = ws.OLEObjects("Bookings")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
ActiveCell.Interior.ColorIndex = 0
ActiveCell.Font.ColorIndex = 1
End If
If Intersect(Target, alpharng) Is Nothing Then Exit Sub
alpharng.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
cboTemp.Activate
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End Sub
I have a combo box which functions as an autocomplete using data validation against a list of members of an organisation. It forms part of a booking form, so that when people book for an event, they can be easily added to a booking list.
I have some code in the Worksheet_SelectionChange Sub which both does the validation, and then sorts the data into alphabetical order...
Its working great, except for one thing: Entering the first entry on row B2, with a header being allowed in the Sort. function so that the header is not included, the entry subsequently appears in cell B25!! If I then enter a second entry, it sorts alphabetically up from there, so the next entry, if alphabetically above will appear at B24, or if alphabetically below, the first entry will shift to B24 and the new entry replace it at B25.
If I change the Order1:=xlAscending to xlDescending it solves the issue, but then I have alphabetical sorting from Z - A which is not what I want at all!
Can anyone help? What have I done wrong?
Here is the code for the SelectionChange sub:
==================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim alpharng As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Set alpharng = Columns("B:B")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set cboTemp = ws.OLEObjects("Bookings")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
ActiveCell.Interior.ColorIndex = 0
ActiveCell.Font.ColorIndex = 1
End If
If Intersect(Target, alpharng) Is Nothing Then Exit Sub
alpharng.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
cboTemp.Activate
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End Sub