Add Unique items

D

Digitborn.com

Active Member
Joined
Apr 3, 2007
Messages
353
Hello,

I have a code which works perfectly and adds the dates from Column A to UserForm1 ComboBox2.
In column B, I have textdata - UserForm1 ComboBox5.

I'd like to transform the code to add only the dates which correspond (cascading) to 1.1 textdata in ComboBox5 (Column B) and 1.2 dates in ComboBox2 (Column A).
Code: 
    ElseIf ComboBox5.ListIndex <> 0 Then
        ComboBox2.Style = fmStyleDropDownList
        ComboBox2.Enabled = True
        ComboBox2.SetFocus
        For Each r In Worksheets("PartsData").Range("A2:A59")
            If r.Offset(, 1).Value = Trim(ComboBox5.Value) Then
                Dim dic As Object, e, d, a
                    Set dic = CreateObject("Scripting.Dictionary")
                    dic.CompareMode = vbTextCompare
                    With Sheets("PartsData")
                        With .Range("A2:AD" & .Range("A" & Rows.Count).End(xlUp).Row)
                            .Sort .Range("A2"), xlAscending
                            a = .Offset(0, 0).Resize(, 1).Value
                        End With
                    End With
                    For Each e In a
                        If Not IsEmpty(e) Then
                            d = Format(e, "dd-mmm-yy")
                        If Not dic.exists(d) Then dic.Add d, Nothing
                        End If
                    Next
                        Me.ComboBox2.List = dic.keys
                    Set dic = Nothing: Erase a
            End If
        Next
    End If
Normaly I know how to do it -> ComboBox2.AddItem = r.Offset(, 1).Value but in this case Me.ComboBox2.List = dic.keys is unknown for me. All code for ComboBox2 is written because of the dates format and sort.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Hi,

Try,

Code: 
Private Sub ComboBox5_Change()
If Len(Me.ComboBox5) > 0 Then
    Dim dic As Object, i    As Long, d, a, z
    z = Me.ComboBox5.Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    With Sheets("PartsData")
        With .Range("A2:AD" & .Range("A" & Rows.Count).End(xlUp).Row)
            .Sort .Range("A2"), xlAscending
            a = .Offset(0, 0).Resize(, 2).Value
        End With
    End With
    For i = 1 To UBound(a, 1)
        If Not IsEmpty(a(i, 1)) Then
            d = Format(a(i, 1), "dd-mmm-yy")
        If Not dic.exists(d) And a(i, 2) = z Then dic.Add d, Nothing
        End If
    Next
    With Me
        .ComboBox2.Clear
        .ComboBox2.List = dic.keys
    End With
    Set dic = Nothing: Erase a
End If
End Sub
 
Upvote 0
Thanks very much Kris, it works perfectly. I only wanted to add one small detail - If there's no any values in ComboBox2 then ComboBox2.Style = fmStyleDropDownCombo
ComboBox2.Value = sign
ComboBox2.Enabled = False

I did some options but failed. Maybe I'm near to fully realize your code and complete it by myself but this small detail tries my nerves :huh:
Code: 
            If Len(Me.ComboBox5) > 0 Then
                Dim dic As Object, i As Long, d, a, z
                z = Me.ComboBox5.Value
                Set dic = CreateObject("Scripting.Dictionary")
                dic.CompareMode = vbTextCompare
                With Sheets("PartsData")
                    With .Range("A2:AD" & .Range("A" & Rows.Count).End(xlUp).Row)
                        .Sort .Range("A2"), xlAscending
                        a = .Offset(0, 0).Resize(, 2).Value
                    End With
                End With
                For i = 1 To UBound(a, 1)
                    If Not IsEmpty(a(i, 1)) Then
                        d = Format(a(i, 1), "dd-mmm-yy")
                        If Not dic.exists(d) And a(i, 2) = z Then dic.Add d, Nothing
                    Else
                        ComboBox2.Style = fmStyleDropDownCombo
                        ComboBox2.Value = sign
                        ComboBox2.Enabled = False
                    End If
                Next
                With Me
                    .ComboBox2.Clear
                    .ComboBox2.List = dic.keys
                End With
                Set dic = Nothing: Erase a

Thanks in advance :roll:
 
Upvote 0
Hi,

Code: 
If Len(Me.ComboBox5) > 0 Then
    Dim dic As Object, i    As Long, d, a, z, y
    z = Me.ComboBox5.Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    With Sheets("PartsData")
        With .Range("A2:AD" & .Range("A" & Rows.Count).End(xlUp).Row)
            .Sort .Range("A2"), xlAscending
            a = .Offset(0, 0).Resize(, 2).Value
        End With
    End With
    For i = 1 To UBound(a, 1)
        If Not IsEmpty(a(i, 1)) Then
            d = Format(a(i, 1), "dd-mmm-yy")
        If Not dic.exists(d) And a(i, 2) = z Then dic.Add d, Nothing
        End If
    Next: y = dic.keys: Set dic = Nothing: Erase a
    If UBound(y) < 0 Then
        With Me.ComboBox2
            .Style = fmStyleDropDownCombo
            .Value = sign
            .Enabled = False
        End With
    Else
        With Me.ComboBox2
            .Enabled = True
            .Clear
            .List = y
        End With
    End If
End If

HTH
 
Upvote 0
Hello Kris,

This is your code, which works perfectly:
Code: 
    With Worksheets("PartsData")
        For Each Combo3P2 In .Range("A2", .Range("A65536").End(xlUp))
            If Len(Me.ComboBox1P2) > 0 Then
                Dim dic As Object, i As Long, d, a, z, y
                z = Me.ComboBox1P2.Value
                Set dic = CreateObject("Scripting.Dictionary")
                dic.CompareMode = vbTextCompare
                    With .Range("A2:BJ" & .Range("A" & Rows.Count).End(xlUp).Row)
                        .Sort .Range("A2"), xlAscending
                        a = .Offset(0, 0).Resize(, 2).Value
                    End With
                For i = 1 To UBound(a, 1)
                    If Not IsEmpty(a(i, 1)) Then
                        d = Format(a(i, 1), "dd-mmm-yy")
                        If Not dic.exists(d) And a(i, 2) = z Then dic.Add d, Nothing
                    End If
                Next: y = dic.keys: Set dic = Nothing: Erase a
                If UBound(y) < 0 Then
                    With Me.ComboBox2P2
                        .Style = fmStyleDropDownCombo
                        .Value = sign
                        .Enabled = False
                    End With
                Else
                    With Me.ComboBox2P2
                        .Enabled = True
                        .Clear
                        .List = y
                    End With
                End If
            End If
        Next
        End With

Please help....I just spend hours and hours of trying and couldn't manage to finalize a code which is very near to yours. All I need is to use the same thing as your code above, but with 2 differences:

1. If MultiPage2.Value = 1 Then not -> If Len(Me.ComboBox5) > 0 Then
This is easy and i can do it, but

2. to add the condition:
If .Cells(Combo3P2.Row, 61).Value = "x" Then
i can't, i don't know where and how exactly.

My eyes went :o staring at this code for at least 5 hours!
 
Upvote 0
Hi,

Code: 
Dim dic As Object, i As Long, d, a, z, y
z = Me.ComboBox1P2.Value
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
    With .Range("A2:BJ" & .Range("A" & Rows.Count).End(xlUp).Row)
        .Sort .Range("A2"), xlAscending
        a = .Offset(0, 0).Resize(, 2).Value
    End With
For i = 1 To UBound(a, 1)
    If Not IsEmpty(a(i, 1)) Then
        d = Format(a(i, 1), "dd-mmm-yy")
        If Not dic.exists(d) And a(i, 2) = z Then dic.Add d, Nothing
    End If
Next: y = dic.keys: Set dic = Nothing: Erase a
If UBound(y) < 0 Then
    With Me.ComboBox2P2
        .Style = fmStyleDropDownCombo
        .Value = sign
        .Enabled = False
    End With
Else
    With Me.ComboBox2P2
        .Enabled = True
        .Clear
        .List = y
    End With
End If

This part of the code works when
Code: 
Len(Me.ComboBox1P2) > 0
.

You can add conditions just before the line
Code: 
Dim dic As Object, i As Long, d, a, z, y

HTH
 
Upvote 0
The target is to add items "dd-mmm-yy" to ComboBox2P2P2. Why it isn't happening with this code:
Code: 
Private Sub MultiPage2_Change()
    With Worksheets("PartsData")
        For Each Combo3P2 In .Range("A2", .Range("A65536").End(xlUp))
            If MultiPage2.Value = 1 Then
                ComboBox1P2P2.Enabled = False
                ComboBox2P2P2.Enabled = True
                ComboBox2P2P2.Clear
                If .Cells(Combo3P2.Row, 61).Value = "x" Then
                    Dim dic As Object, i As Long, d, a, y
                    Set dic = CreateObject("Scripting.Dictionary")
                    dic.CompareMode = vbTextCompare
                        With .Range("A2:BJ" & .Range("A" & Rows.Count).End(xlUp).Row)
                            .Sort .Range("A2"), xlAscending
                            a = .Offset(0, 0).Resize(, 2).Value
                        End With
                    For i = 1 To UBound(a, 1)
                        If Not IsEmpty(a(i, 1)) Then
                            d = Format(a(i, 1), "dd-mmm-yy")
                            If Not dic.exists(d) Then dic.Add d, Nothing
                        End If
                    Next: y = dic.keys: Set dic = Nothing: Erase a
                    If UBound(y) < 0 Then
                        With Me.ComboBox2P2
                            .Style = fmStyleDropDownCombo
                            .Value = sign
                            .Enabled = False
                        End With
                    Else
                        With Me.ComboBox2P2
                            .Enabled = True
                            .Clear
                            .List = y
                        End With
                    End If
                End If
            End If
         Next
    End With
End Sub
 
Upvote 0
Hi try,

Code: 
Private Sub MultiPage2_Change()
    With Worksheets("PartsData")
        If MultiPage2.Value = 1 Then
            ComboBox1P2P2.Enabled = False
            ComboBox2P2P2.Enabled = True
            ComboBox2P2P2.Clear
            Dim dic As Object, i As Long, d, a, y
            Set dic = CreateObject("Scripting.Dictionary")
            dic.CompareMode = vbTextCompare
            With .Range("A2:BJ" & .Range("A" & Rows.Count).End(xlUp).Row)
                .Sort .Range("A2"), xlAscending
                a = .Value
            End With
            For i = 1 To UBound(a, 1)
                If Not IsEmpty(a(i, 1)) Then
                    d = Format(a(i, 1), "dd-mmm-yy")
                    If Not dic.exists(d) And a(i, 61) = "x" Then
                        dic.Add d, Nothing
                    End If
                End If
            Next: y = dic.keys: Set dic = Nothing: Erase a
            If UBound(y) < 0 Then
                With Me.ComboBox2P2
                    .Style = fmStyleDropDownCombo
                    .Value = sign
                    .Enabled = False
                End With
            Else
                With Me.ComboBox2P2
                    .Enabled = True
                    .Clear
                    .List = y
                End With
            End If
        End If
    End With
End Sub

HTH
 
Upvote 0
Thanks, that's right. I tried to change many times the lines:
a = .Value
If Not dic.exists(d) And a(i, 61) = "x" Then

and I knew the answer and logic was there, but I couldn't get to this point. Thanks again Kris :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
Filter data in listbox based on three conditions by selected from combobox
Replies
1
Views
458
tubrak
T
R
  • Question Question
Msg box for
Replies
1
Views
253
Micron
M
G
  • Question Question
Cannot create a new time-in entry
Replies
2
Views
183
genesix
G
A
  • Solved
add another condition to filter data based on month in listbox on userform
Replies
3
Views
564
abdelfattah
A
B
  • Question Question
Excel 365 Compare Date & Copy Cell Data for Data Base
2 3 4
Replies
33
Views
1K
skillilea
S

Forum statistics

Threads
1,223,833
Messages
6,174,907
Members
452,590
Latest member
CraiginColorado

Share this page

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
Back
Top