ComboBox Populating Data With Max Values

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
701
Office Version
  1. 365
Platform
  1. Windows
I have a form with a combobox, that is tied to a range on a worksheet. The range can have multiple duplicate values. When a user selects a value from a drop down box, I'd like them to see only 1 of the possible values, and have the data presented tied to the max date of the Update Date. Essentially, if the worksheet has 5 entries where the name = "Tom" and the Update Date is 5/1/17, 6/1/17, 7/8/17, 8/1/17, 10/1/17, I want the User to only see one instance of Tom in the combo box (along with the other names in there), and the data presented in the rest of the form to be tied to the record from 10/1/17.

I've searched this, and other sites, and haven't found anything that makes sense to me. That's probably b/c I'm still new to VBA, and trying to piece things together.

Code:
Private Sub cmd_Submit_Click()

Dim ws1 As Worksheet


Set ws1 = ThisWorkbook.Sheets("Client Measurements")


LastRow = ws1.Range("C" & Rows.Count).End(xlUp).Row + 1


ws1.Range("B" & LastRow) = Me.txt_Updated
ws1.Range("C" & LastRow) = Me.txt_First
ws1.Range("D" & LastRow) = Me.txt_Last
ws1.Range("E" & LastRow) = Me.txt_Suffix
ws1.Range("F" & LastRow) = Me.cobo_Name
ws1.Range("G" & LastRow) = Me.txt_EntryType
ws1.Range("H" & LastRow) = Me.txt_Height
ws1.Range("I" & LastRow) = Me.txt_Weight
ws1.Range("J" & LastRow) = Me.txt_Chest
ws1.Range("K" & LastRow) = Me.txt_Hips
ws1.Range("L" & LastRow) = Me.txt_Waist
ws1.Range("M" & LastRow) = Me.txt_BicepL
ws1.Range("N" & LastRow) = Me.txt_BicepR
ws1.Range("O" & LastRow) = Me.txt_ThighL
ws1.Range("P" & LastRow) = Me.txt_ThighR
ws1.Range("Q" & LastRow) = Me.txt_CalfL
ws1.Range("R" & LastRow) = Me.txt_CalfR




End Sub
Private Sub cobo_Name_DropButt*******()


Dim i As Long
Dim coll As Collection
Dim ws1 As Worksheet


Set ws1 = ThisWorkbook.Sheets("Client Measurements")


LastRow = Sheets("Client Measurements").Range("F" & Rows.Count).End(xlUp).Row


For i = 2 To LastRow


If Sheets("Client Measurements").Cells(i, "F").Value = (Me.cobo_Name) Or _
Sheets("Client Measurements").Cells(i, "F").Value = Val(Me.cobo_Name) Then
    Me.txt_First = Sheets("Client Measurements").Cells(i, "C").Value
    Me.txt_Last = Sheets("Client Measurements").Cells(i, "D").Value
    Me.txt_Suffix = Sheets("Client Measurements").Cells(i, "E").Value
    Me.txt_Height = Sheets("Client Measurements").Cells(i, "H").Value
    Me.txt_Weight = Sheets("Client Measurements").Cells(i, "I").Value
    Me.txt_Chest = Sheets("Client Measurements").Cells(i, "J").Value
    Me.txt_Hips = Sheets("Client Measurements").Cells(i, "K").Value
    Me.txt_Waist = Sheets("Client Measurements").Cells(i, "L").Value
    Me.txt_BicepL = Sheets("Client Measurements").Cells(i, "M").Value
    Me.txt_BicepR = Sheets("Client Measurements").Cells(i, "N").Value
    Me.txt_ThighL = Sheets("Client Measurements").Cells(i, "O").Value
    Me.txt_ThighR = Sheets("Client Measurements").Cells(i, "P").Value
    Me.txt_CalfL = Sheets("Client Measurements").Cells(i, "Q").Value
    Me.txt_CalfR = Sheets("Client Measurements").Cells(i, "R").Value
    


End If
Next
End Sub


Private Sub UserForm_Initialize()


Dim ws1 As Worksheet
Dim cCMName As Range


Set ws1 = ThisWorkbook.Sheets("Client Measurements")


For Each cCMName In ws1.Range("CMName")
    With Me.cobo_Name
        .AddItem cCMName.Value
    End With
Next cCMName


txt_EntryType = "Check In"


End Sub
 
It's pulling in record 22. I added more test records and it started to work, but then it stopped. It appears to work better if I sort the worksheet by name, then by update date.
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I imagine I can figure out the coding for the sorting. If not, I'll circle back. Thank you so much for the help.
 
Last edited:
Upvote 0
Are your dates real dates? Select one of the dates & set the cell format to general do you see a number like 43061?
 
Upvote 0
OK try this change
Code:
Private Sub UserForm_Initialize()


    Dim Ws1 As Worksheet
    Dim cCMName As Range
    
    
    Set Ws1 = ThisWorkbook.Sheets("Data List")
    
    Set coboDict = CreateObject("scripting.dictionary")
    With coboDict
        For Each cCMName In Ws1.Range("CMName")
            If Not .exists(cCMName.Value) Then
                .Add cCMName.Value, cCMName.Row
            Else
                If CLng(cCMName.Offset(, -4).Value) > CLng(Ws1.Range("B" & .Item(cCMName.Value))) Then
                    .Item(cCMName.Value) = cCMName.Row
                End If
            End If
        Next cCMName
        Me.cobo_Name.list = Application.Transpose(.keys)
    End With
    txt_EntryType = "Check In"
End Sub
 
Upvote 0
Fluff - If you celebrate it, Happy Thanksgiving! Thank you for the response. I incorporated the change and it worked. I tested it further by adding a new, greater date and the code didn't pick it up. However, when I sorted the data set, the code did pick it up. So, I'm thinking that if I add the code to sort the data when the form initializes, I should be good to go.

I'm want to make sure I understand what the code does, instead of just using it. Is this snippet supposed to add a record if it wasn't available in the range?
Code:
[COLOR=#333333]For Each cCMName In Ws1.Range("CMName")[/COLOR]            If Not .exists(cCMName.Value) Then [COLOR=#333333]                .Add cCMName.Value, cCMName.Row[/COLOR]
Can you help me understand what the purpose of this snippet is?
Code:
[COLOR=#333333]Me.cobo_Name.list = Application.Transpose(.keys)[/COLOR]

Thanks for all of the help!
 
Upvote 0
Not sure why it's not working for you. :confused:
Hope this explanation helps
Code:
Private Sub UserForm_Initialize()


          Dim Ws1 As Worksheet
          Dim cCMName As Range
          
          
1         Set Ws1 = ThisWorkbook.Sheets("Data List")
          
2         Set coboDict = CreateObject("scripting.dictionary")
3         With coboDict
4             For Each cCMName In Ws1.Range("CMName")
5                 If Not .exists(cCMName.Value) Then
6                     .Add cCMName.Value, cCMName.Row
7                 Else
8                     If cCMName.Offset(, -4).Value > Ws1.Range("B" & .Item(cCMName.Value)) Then
9                         .Item(cCMName.Value) = cCMName.Row
10                    End If
11                End If
12            Next cCMName
13            Me.cobo_Name.list = Application.Transpose(.keys)
14        End With
15        txt_EntryType = "Check In"
End Sub
5) checks to see if the name is in the dictionary
6) if it's not in the dictionary add the name as the Key & the row number as the Item.
So if the first name was Fluff (on row 2) the Key would be Fluff & the Item would be 2
8) If the name is in the dictionary this should check if the new date is greater than the existing date
So if Fluff is also found on row 4 it would check B4 against B2 (where the existing Item for Key Fluff is 2)
9) If the new date is greater than the previous date replace the existing Item (ie row number) with the new row number
10) Take the Keys in the dictionary (ie the names) transpose into a vertical array & use that to populate the combobox


If you need help with the sort, just shout.
 
Last edited:
Upvote 0
Thank you very much for the help @Fluff! I just don't want to be one of those folks that uses code someone puts together and moves on. This is what will help me understand the code, so that I have a better shot of doing it on my own next time. Your time and guidance is appreciated!!
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,215,429
Messages
6,124,837
Members
449,193
Latest member
MikeVol

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