Leading zero lost in Combobox

[rdwhitney]

I can't seem to find a way to save leading zeros in my Combobox list. The zeros are necessary since they correspond to unique IDs and are formated as text in the worksheet. These unique numbers may appear more than once so I'm using this portion of the form to narrow down my selection. The source for the list is a dynamic named range. Unfortinitly if the leading zero(s) are missing from my selection in the combo box the filterd results for the next section is worthless. It works like a charm for any IDs without a leading zero.

Here's what I have. I'd appreciate any help I can get.


Private Sub UserForm_Initialize()

Dim e As Variant
Dim ws As Worksheet
Set ws = Worksheets("RepairData")
For Each e In SortArray(UniqueValues(ws.Range("SurveyTag_List")))
CB_SurveyTag.AddItem e
Next e

 

[Yongle]

Are numbers consistent in length ?
- amend code below which is good for 8 character numbers

[COLOR=#333333]CB_SurveyTag.AddItem Format(E,"00000000")[/COLOR]

 

[rdwhitney]

Are numbers consistent in length ?
- amend code below which is good for 8 character numbers

[COLOR=#333333]CB_SurveyTag.AddItem Format(E,"00000000")[/COLOR]

Thanks for the quick reply Yongle. Unfortunately, there is no consistency to the entries. They are anywhere from 2 - 8 characters and some contain text.

 

[Akuini]

Let's debug it first.
What's the result in the immediate window if you try this:

Sub tryz()
Dim e As Variant
Dim ws As Worksheet
Set ws = Worksheets("RepairData")
    For Each e In SortArray(UniqueValues(ws.Range("SurveyTag_List")))
    Debug.Print CStr(e)
    Next e

End Sub

Is the leading zeros still there?

 

[rdwhitney]

Akuini, I’ve run and see no action or result.

 

[Yongle]

Look in the immediate window
In VBA editor make immediate window visible with {ctrl} G

 

[rdwhitney]

Well you lrearn somrthing new every day..... The leading zeros are still not displayed in the immediate window.

 

[Akuini]

Well you lrearn somrthing new every day..... The leading zeros are still not displayed in the immediate window.

Then the problem isn't in populating the array to combobox but in the array itself, i.e this part:

SortArray(UniqueValues(ws.Range("SurveyTag_List")))

It would be helpful if you could upload a sample workbook to a site such as dropbox.com then put the link here. So it will be easier for us to try to find out what is causing the problem.

 

[rdwhitney]

It's been awhile since I put this together so I didn't remember the following -

Public Function UniqueValues(theRange As Range) As Variant    Dim colUniques As New VBA.Collection
    Dim vArr As Variant
    Dim vCell As Variant
    Dim vLcell As Variant
    Dim oRng As Excel.Range
    Dim i As Long
    Dim vUnique As Variant
    Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
    vArr = oRng
    On Error Resume Next
    For Each vCell In vArr
        If vCell <> vLcell Then
            If Len(CStr(vCell)) > 0 Then
                colUniques.Add vCell, CStr(vCell)
            End If
        End If
        vLcell = vCell
    Next vCell
    On Error GoTo 0
     
    ReDim vUnique(1 To colUniques.Count)
    For i = LBound(vUnique) To UBound(vUnique)
        vUnique(i) = colUniques(i)
    Next i
     
    UniqueValues = vUnique
End Function

Here's a link to the file

https://www.dropbox.com/sh/jtgblcn5l38yjiv/AAAH3CK5C9nPIET5I8i9D4hta?dl=0

 

[Akuini]

There's a lot going on in the macro of your workbook. I don't quite understand how it works, but it seems a bit complicated way to get a unique & sorted data populated to the combobox. But just add this line:
Range("A:A").NumberFormat = "@"
in "Function SortArray", see if it resolves the issue.

Function SortArray(ByRef MyArray As Variant, Optional Order As Long = xlAscending) As Variant
    Dim w As Worksheet
    Dim r As Range
     
    Set w = ThisWorkbook.Worksheets.Add()
     
    On Error Resume Next
   [COLOR=#0000ff] Range("A:A").NumberFormat = "@"[/COLOR]
    Range("A4").Resize(UBound(MyArray, 1), 1) = WorksheetFunction.Transpose(MyArray)
    Range("A4").Resize(UBound(MyArray, 1), UBound(MyArray, 2)) = WorksheetFunction.Transpose(MyArray)
    Set r = w.UsedRange
    If Order = xlAscending Then
        r.Sort Key1:=r.Cells(1, 1), Order1:=xlAscending
    Else
        r.Sort Key1:=r.Cells(1, 1), Order1:=xlDescending
    End If
   
    SortArray = r
     
    Set r = Nothing
    Application.DisplayAlerts = False
    w.Delete
    Application.DisplayAlerts = True
    Set w = Nothing
End Function

Here's an example how I would do to get a unique & sorted data populated to a combobox.

Private Sub UserForm_Initialize()
Call toSortUnique
End Sub


Sub toSortUnique()

Dim dar As Object, vlist, i As Long
With Sheets("RepairData")
vlist = .Range("A4", .Cells(.Rows.Count, "A").End(xlUp))
End With

With ComboBox1
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(vlist) To UBound(vlist)
            If Not dar.Contains(vlist(i, 1)) And vlist(i, 1) <> "" Then
                dar.Add vlist(i, 1)
            End If
    Next
        dar.Sort
       .List = dar.Toarray()
End With
End Sub