Private Sub cmbtest_Change()
'Define Application Array
Dim Arr_Application()
'Size Array
ReDim Arr_Application(100)
'Declare last row in table
Dim LastRow As Long
LastRow = ActiveSheet.Cells(65536, 1).End(xlUp).Row
'Fill Array
Dim i As Long 'row counter
Dim ipos As Long 'array fill counter
i = 1
Do While i <= LastRow
If Cells(i, 5).Value Then
Me.cmbtest.Value
ipos = ipos + 1
End If
i = i + 1
Loop
'Resize Application Array
ReDim Preserve Arr_Application(ipos - 1)
'Sort Application Array Alphabetically
Dim lLoop As Long
Dim lLoop2 As Long
Dim str1 As String
Dim str2 As String
'Sort Application Analysis Array
For lLoop = 0 To UBound(Arr_Application)
For lLoop2 = lLoop To UBound(Arr_Application)
If UCase(Arr_Application(lLoop2)) < UCase(Arr_Application(lLoop)) Then
str1 = Arr_Application(lLoop)
str2 = Arr_Application(lLoop2)
Arr_Application(lLoop) = str2
Arr_Application(lLoop2) = str1
End If
Next lLoop2
Next lLoop
'Reduce Array to Unique Values Only
Dim Arr_Application_Unique()
ReDim Arr_Application_Unique(ipos - 1)
'Store first entry
Arr_Application_Unique(0) = Arr_Application(0)
Dim NewSize As Long
i = 1 'reset counter
Do While i <= UBound(Arr_Application)
If Arr_Application(i) <> Arr_Application(i - 1) Then
Arr_Application_Unique(NewSize + 1) = Arr_Application(i)
NewSize = NewSize + 1
End If
i = i + 1
Loop
'Resize Unique Array
ReDim Preserve Arr_Application_Unique(NewSize)
'Populate Application ComboBox
Me.cmbtest.List = Arr_Application_Unique
End Sub
editted code as it was to try and read data into a dropdown but no luck.. no errors prompted, or does anyone know an easier way to read excel information to a combo box?
Bookmarks