ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   filtering out duplicate data values (https://www.excelbanter.com/excel-programming/395259-filtering-out-duplicate-data-values.html)

[email protected]

filtering out duplicate data values
 
can someone help me modify this code so that my combobox filters out
duplicate values?

Private Sub UserForm_Initialize()
Dim ListStates As Variant, i As Integer
Dim SourceWB As Workbook

With Me.cboState
.Clear ' remove existing entries from the listbox
' turn screen updating off,
' prevent seeing source workbook being opened
Application.ScreenUpdating = False
' open source workbook as ReadOnly
Set SourceWB = Workbooks.Open("H:\Project Tracking db\FY08 Per
Diem Rates.xls", _
False, True)
ListStates = SourceWB.Worksheets(1).Range("A4:A666").Value
' get values
SourceWB.Close False ' close source workbook without saving
Set SourceWB = Nothing
ListStates =
Application.WorksheetFunction.Transpose(ListStates )
' convert values to a vertical array
For i = 1 To UBound(ListStates)
.AddItem ListStates(i) ' populate the listbox
Next i
.ListIndex = -1 ' no items selected, set to 0 to select the
first item
Application.ScreenUpdating = True
End With
End Sub


JMB

filtering out duplicate data values
 
One method of filtering out the duplicates is to use a collection. Items in
a collection cannot have the same "key", so you can temporarily disable error
handling, add all of the values to the collection (using the value as it's
own "key"), then add your collection of unique values to the listbox. An
example using some dummy data I set up in A1:A8 on my end:

Sub test()
Dim v As Variant
Dim colUnique As Collection
Dim i As Long

Set colUnique = New Collection
v = Application.Transpose(Range("A1:A8").Value)

On Error Resume Next
For i = LBound(v) To UBound(v)
colUnique.Add v(i), CStr(v(i))
Next i
On Error GoTo 0

For i = 1 To colUnique.Count
MsgBox colUnique(i)
'Add values to Listbox
Next i

End Sub

" wrote:

can someone help me modify this code so that my combobox filters out
duplicate values?

Private Sub UserForm_Initialize()
Dim ListStates As Variant, i As Integer
Dim SourceWB As Workbook

With Me.cboState
.Clear ' remove existing entries from the listbox
' turn screen updating off,
' prevent seeing source workbook being opened
Application.ScreenUpdating = False
' open source workbook as ReadOnly
Set SourceWB = Workbooks.Open("H:\Project Tracking db\FY08 Per
Diem Rates.xls", _
False, True)
ListStates = SourceWB.Worksheets(1).Range("A4:A666").Value
' get values
SourceWB.Close False ' close source workbook without saving
Set SourceWB = Nothing
ListStates =
Application.WorksheetFunction.Transpose(ListStates )
' convert values to a vertical array
For i = 1 To UBound(ListStates)
.AddItem ListStates(i) ' populate the listbox
Next i
.ListIndex = -1 ' no items selected, set to 0 to select the
first item
Application.ScreenUpdating = True
End With
End Sub



Michael

filtering out duplicate data values
 

Tyr this:
Private Sub UserForm_Initialize()

Dim ListStates As Variant, i As Integer

Dim SourceWB As Workbook



With Me.cboState

.Clear ' remove existing entries from the listbox

' turn screen updating off,

' prevent seeing source workbook being opened

Application.ScreenUpdating = False

' open source workbook as ReadOnly

Set SourceWB = Workbooks.Open("H:\Project Tracking db\FY08 Per

Diem Rates.xls", _

False, True)

SourceWB.Worksheets(1).Range("A4:A666").AdvancedFi lter
xlFilterInPlace
ListStates = SourceWB.Worksheets(1).Range("A4:A666").Value

' get values

SourceWB.Close False ' close source workbook without saving

Set SourceWB = Nothing

ListStates =

Application.WorksheetFunction.Transpose(ListStates )

' convert values to a vertical array

For i = 1 To UBound(ListStates)

.AddItem ListStates(i) ' populate the listbox

Next i

.ListIndex = -1 ' no items selected, set to 0 to select the

first item

Application.ScreenUpdating = True

End With




All times are GMT +1. The time now is 05:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com