A-Z list box isnt in order

[ipbr21054]

Hi,

I have a worksheet which is sorted from old to new date in column A where A9 is 02/01/2017 & A978 is 07/10/2019
In column B are the customers names.

A code collects all the names column B & sorts them into an A-Z order, this takes place in column L

I have a userform where a field called NameForDateEntryBox shows the sorted customers from column L now in an A-Z order on the userform.

I believe the code supplied here is what you require.

Private Sub UserForm_Initialize()
Dim cl As Range
Dim rng As Range
Dim lstrw As Long
Dim lastrow As Long
Dim Lastrowa As Long
Dim cntr As Integer
Load PostageTransferSheet
TextBox2.SetFocus
'==============================================================================================
Application.ScreenUpdating = False
lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("POSTAGE").Cells(8, 2).Resize(lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   cntr = 1
   With Sheets("POSTAGE")
      lstrw = .Range("B65536").End(xlUp).Row
      Set rng = .Range("B8:B" & lstrw)
      For Each cl In rng
         If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1
      Next
      Select Case cntr
         Case 1
            NameForDateEntryBox.Clear
            MsgBox "POSTAGE LIST IS NOW EMPTY OF CUSTOMERS NAMES", vbExclamation, "POSTAGE LIST NO NAMES MESSAGE"
            Unload PostageTransferSheet
         Case 2
            NameForDateEntryBox.Clear
            NameForDateEntryBox.AddItem .Range("L1").Value
            .Range("L1").Clear
         Case Else
            .Range("L1:L" & cntr - 1).Sort key1:=.Range("L1"), order1:=xlAscending, Header:=xlNo
            NameForDateEntryBox.List = .Range("L1:L" & cntr - 1).Value
            .Range("L1:L" & cntr - 1).Clear
      End Select
   End With
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Application.ScreenUpdating = True


TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub

See screen shot of what i mean.

 

[ipbr21054]

Sorry im lost,
Please show me in my code supplied first post which you mean

Thanks

 

[MoshiM]

Sorry im lost,
Please show me in my code supplied first post which you mean

Thanks

Private Sub UserForm_Initialize()
Dim cl As Range
Dim rng As Range
Dim lstrw As Long
Dim lastrow As Long
Dim Lastrowa As Long
Dim cntr As Integer
[COLOR=#ff0000]Dim x As Long
Dim LB As Object
Dim Temp_A As Variant[/COLOR]
Load PostageTransferSheet
TextBox2.SetFocus
'==============================================================================================
Application.ScreenUpdating = False
lastrow = Sheets("POSTAGE").Cells(Rows.count, "B").End(xlUp).Row
Sheets("POSTAGE").Cells(8, 2).Resize(lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
Lastrowa = Sheets("POSTAGE").Cells(Rows.count, "L").End(xlUp).Row
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   cntr = 1
   With Sheets("POSTAGE")
      lstrw = .Range("B65536").End(xlUp).Row
      Set rng = .Range("B8:B" & lstrw)
      For Each cl In rng
         If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1
      Next
      Select Case cntr
         Case 1
            NameForDateEntryBox.Clear
            MsgBox "POSTAGE LIST IS NOW EMPTY OF CUSTOMERS NAMES", vbExclamation, "POSTAGE LIST NO NAMES MESSAGE"
            Unload PostageTransferSheet
         Case 2
            NameForDateEntryBox.Clear
            NameForDateEntryBox.AddItem .Range("L1").Value
            .Range("L1").Clear
         Case Else
         
[COLOR=#ff0000]            Set LB = CreateObject("System.Collections.ArrayList")
            Temp_A = .Range("L1:L" & cntr - 1).Value
                     .Range("L1:L" & cntr - 1).Clear
            For x = 1 To UBound(Temp_A, 1)
                LB.Add Temp_A(x, 1)
            Next x
            LB.Sort
            NameForDateEntryBox.List = LB.toarray
            [/COLOR]
            
      End Select
   End With
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Application.ScreenUpdating = True




TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub

 

[ipbr21054]

Its working now thanks