Extract Unique Values Based On Dependant Combobox Selections

[roninn75]

hi all
i have a source sheet and a resultant sheet. i have a form with comboboxes on which gets it data from the source sheet.
i have 3 dependant combobox on the form. combobox 1 is populated on userform_initialize, combobox 2 is then populated by a unique list of values based on combobox 1, combobox 3 is populated by a unique list of values based on combobox 2.
i now need to load the unique list of resultant values from combobox 3 in a dynamic range or array and print it to a sheet using a command button. here are two conditions though,
1. the columns in the resultant sheet is: A = District, B = Town, C = Name and D = Number. each of the comboboxes represents a column. so i need to print the unique numbers in column D to the resultant sheet, and
2. it has to actually duplicate the unique values under each of the other columns.

so in the resultant sheet, once the process is completed and it is printing say 4 unique numbers under column D, it has to duplicate from column A (District) to column C(Name) those values that belongs to column D(number).
the result would look like this after clicking the command button:
DISTRICT TOWN NAME NUMBER
NORTH A JOHN A123
NORTH A JOHN A786
NORTH A JOHN B124
NORTH A JOHN B456

[Excel Fox]

Can be done. But to make it easier for the developer, it would be better to have a sample working model. Can you share your userform and vba code?

[Excel Fox]

Cross-posted at MS Excel, Access and VBA Discussion Forum

[roninn75]

attached please find a sample workbook. as you will see, i have used a listbox on the form to show the unique numbers.

regards

Can be done. But to make it easier for the developer, it would be better to have a sample working model. Can you share your userform and vba code?

[Excel Fox]

Just made the necessary correction to your specific need, and didn't really look at the formatting of the code. Use this for the submit button

Private Sub BtnSubmit_Click()
Dim wsS As Worksheet
Dim wsR As Worksheet

Application.ScreenUpdating = False

Dim irow As Long, lngLoop As Long

Set wsS = Worksheets("Resultant")
'find first row in database
irow = wsS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With wsS
For lngLoop = 0 To Me.ListStaIncNo.ListCount - 1
.Range("A" & irow + lngLoop).Value = Trim(Me.BxStaDistrict.Value)
.Range("B" & irow + lngLoop).Value = Trim(Me.BxStaTown.Value)
.Range("C" & irow + lngLoop).Value = Trim(Me.BxStaName.Value)
.Range("D" & irow + lngLoop).Value = Me.ListStaIncNo.List(lngLoop)
.Range("E" & irow + lngLoop).Value = Date
.Range("F" & irow + lngLoop).Value = Time
.Range("G" & irow + lngLoop).Value = Environ$("USERNAME")
Next lngLoop
End With

MsgBox "Data succesfully saved to database"

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

In addition, there's a fault with your listbox getting refreshed. The items has to be cleared first, before loading again with other criterias via the combobox. For that, I've added one line in this routine

Private Sub BxStaName_AfterUpdate()

    Dim Cl     As Range
    Dim ClAddress As String
    With Me
    With Sheets("Source")
        Set rSource = .Range(.Cells(1, 4), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'if no selection in OIC quit
        If .BxStaName.ListIndex < 0 Then Exit Sub
        Set Cl = rSource.Find(Me.BxStaName.Value, LookIn:=xlValues)
        If Not Cl Is Nothing Then
            ClAddress = Cl.Address
            Me.ListStaIncNo.Clear
            Do
                .ListStaIncNo.AddItem Cl.Offset(0, 1).Value
              
                Set Cl = rSource.FindNext(Cl)
            Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
        End If
    End With
End Sub

And here's the file.

By the way, hope you've read the guidelines about forum cross posting.

[roninn75]

thank you so much. this works. i will mark the other post as solved here. again thank you.