Thread: Combobox alternatives based on a range

Hi,

I have a simple but still very annoying problem...

I have a list of persons, as in my dummybook. The list can contain any
number of personons. I want to put all of the dates in a combobox as
alternatives, but only one of each and no blank alternatives.

So the combobox should contain unique values and no blank values!

The combobox should also uppdate itself when a new post is added.

How do I get this to work ?

Many thanks!!

//

Per

Hi Pero

One way is to create a dynamic named range of the dates. Advanced Filter the date range (including the header) to sheet2 then name that range. See attached.

Sorry, I left a piece of code out...I'll repost the workbook.

Hi Pero

Actually, there is a way to do this

It must be possible to write a VBA-code that adds all unique dates to a array

and I worked with something like that recently. I'll need to dig through my scrap heap and see if I can give you an example.

Hi Pero

Notice this Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
Place this code in a general module

Option Explicit
Sub Test_UniqueArray()
    Dim a As Variant
    Dim lr As Long
    Dim i As Long
    lr = Range("N" & Rows.Count).End(xlUp).Row
    a = Worksheets("Sheet1").Range("N7:N" & lr).Value
    a = UniqueArray(a)
    Sheet1.ComboBox1.List = WorksheetFunction.Transpose(a)
End Sub
 
 
Function UniqueArray(anArray As Variant) As Variant
'Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
    Dim d As New Scripting.Dictionary, a As Variant
    With d
        .CompareMode = TextCompare
        For Each a In anArray
            If Not Len(a) = 0 And Not .Exists(a) Then
                .Add a, Nothing
            End If
        Next a
        UniqueArray = d.keys
    End With
    Set d = Nothing
End Function

Place this code in Sheet1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long
    lr = Range("N" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("N7:N" & lr)) Is Nothing Then
        Call Test_UniqueArray
    End If
End Sub

Let me know of issues.

Hi, Thanks ! Almost works..

If the list only contains one personi get an error "Type missmatch" on
line:

For Each a In anArray

That must be because anArray is difined as a variant and when it only contains one element variant will choose "wrong" datatype for "anArray" and "For Each a in anArray" wont work.

I'm I right ?


EDIT:

Also , the dates in the combobox are displayed in another format then in the actual list. The list contains dates in format YYYY-MM-DD but in the combobox list its : MM-DD-YYYY
I want it to be YYYY-MM-DD in the combobox aswell!

Thanks again !

Hi Pero

Modify the code as follows

Option Explicit
Sub Test_UniqueArray()
    Dim a As Variant
    Dim lr As Long
    Dim i As Long
    lr = Range("N" & Rows.Count).End(xlUp).Row
    a = Worksheets("Sheet1").Range("N7:N" & lr).Value
 
    Sheet1.ComboBox1.Clear
  If lr = 7 Then
      Sheet1.ComboBox1.AddItem a
  Else
        a = UniqueArray(a)
        Sheet1.ComboBox1.List = WorksheetFunction.Transpose(a)
    End If
End Sub
 
 
Function UniqueArray(anArray As Variant) As Variant
'Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
    Dim d As New Scripting.Dictionary, a As Variant
    With d
        .CompareMode = TextCompare
        For Each a In anArray
            If Not Len(a) = 0 And Not .Exists(a) Then
                .Add a, Nothing
            End If
        Next a
        UniqueArray = d.keys
    End With
    Set d = Nothing
End Function

Let me know of issues.