VBA Unique List In Combo Box

ir121973

Active Member
Joined
Feb 9, 2008
Messages
371
Hi, I wonder whether someone may be able to help me please.

I'm using this example Excel vba: Populate a combo box (form control) | Get Digital Help - Microsoft Excel resource to create a combo box which contains unique values from a given spreadsheet list.

If I use the default layout provide in the example, I can re-create the the desired outcome. However if I cut and paste th elist to a different location i.e F2 instead of A2, I loose the list from the combo box.

I've changed the code from

Code:
With Worksheets("Sheet1")
        Lrow = .Range("A" & Rows.Count).End(xlUp).Row
    temp = .Range("A2:A" & Lrow).Value
    End With

to

Code:
  With Worksheets("Sheet1")
        Lrow = .Range("F" & Rows.Count).End(xlUp).Row
    temp = .Range("F2:F" & Lrow).Value
    End With

to account for this, but I still can't get this to work.

I just wondered whether somoene may be able to look at this please and let me know where I'm going wrong.

Many thanks and kind regards

Chris
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Can't see anything wrong there.
This is the same code modfied for different sheet, and "Drop down" name and based on column "F"
This worked for me
Code:
Sub FilterUniqueData()
    Dim Lrow As Long, test As New Collection
    Dim Value As Variant, temp() As Variant
    ReDim temp(0)
    On Error Resume Next
    With Worksheets("Sheet33")
        Lrow = .Range("F" & Rows.Count).End(xlUp).Row
    temp = .Range("F2:F" & Lrow).Value
    End With
    For Each Value In temp
        If Len(Value) > 0 Then test.Add Value, CStr(Value)
    Next Value
    Worksheets("Sheet33").Shapes("Drop Down 3").ControlFormat.RemoveAllItems
    For Each Value In test
         Worksheets("Sheet33").Shapes("Drop Down 3").ControlFormat.AddItem Value
    Next Value
    Set test = Nothing
End Sub
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,508
Office Version
  1. 2019
Platform
  1. Windows
Nothing that I can see wrong with what you have done. But as a thought, further down the page is a worksheet_Chang event code

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A:$A")) Is Nothing Then
    Call FilterUniqueData
End If
End Sub

If you rely on this to call your procedure then you need to update code to the required range.

Hope helpful

Dave
 

ir121973

Active Member
Joined
Feb 9, 2008
Messages
371
Hi @dmt32 and MickG, thank you both of you for taking the time to reply to my post.

I'm using Office 2013, and because I'm still trying to get to grips with this, I'd perhaps, initally, created the file with an error but everything seems to be working ok now.

Once again, many thanks and kind regards

Chris
 

Watch MrExcel Video

Forum statistics

Threads
1,129,472
Messages
5,636,516
Members
416,920
Latest member
Riskyplan

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