Combo box initialization problem via VBA coding

I have 3 worksheets in my Activeworkbook. Worksheet 1 has number 101,102,1000,1001,1002 in it in vertical format in column A. Worksheet 2 has number 101,102,1000,1001,1002,1003,1004 in it in vertical format in column A. Worksheet 3 has 101,102,1000,1001,1002,1003 in it in vertical form also in Column A. I have done the initialization VBA coding to initialize those numbers into my combobox, instead of loading those UNIQUE numbers into my combobox, it load all the numbers into my combobox and as a result I have duplicate items in my commbox (for example, number 101 appear 3 times instead of appearing only once in my combobox). Here is my VBA coding:-

Private Sub UserForm_Initialize()

Dim intIndex As Integer
Dim shtThisSheet As Worksheet
Dim strServiceID As String
Dim rngData As Range
Dim rngCell As Range

'set range table
For intIndex = 1 To 3
Set shtThisSheet = ActiveWorkbook.Worksheets(intIndex)
shtThisSheet.Activate

'currentregion to find range with data
Set rngData = shtThisSheet.Range("A3").CurrentRegion
Set rngData = rngData.Offset(Rowoffset:=2) _
.Resize(rowsize:=rngData.Rows.Count - 3, ColumnSize:=rngData.Columns.Count - 6)

'assign column heading strServiceID variable
strServiceID = "ServiceID"

'sort ServiceID data, then add only unique ServiceIDs to combobox
rngData.Sort key1:=strServiceID, header:=xlYes
For Each rngCell In rngData.Cells
If rngCell.Value <> strServiceID Then
cboAddExistingDataSelectServiceID.AddItem rngCell.Value
End If

Next rngCell

Next intIndex

End Sub

All help is very much appreciated. Thank you.

Richie,

thank you for your reply but unfortunately, the sample coding from J-Walk doesn't seem to work in my case.

I got this error message saying that Run Time Error '457' which said that the NoDupes key is already associated with an element of this collection.

Do you know how to solve this problem?

Thank you.

Richie,

Thanks again for your reply.

I have downloaded your sample coding for my problem. I have put your macro coding to run, sometimes it could run smoothly and SOMETIMES the button could not function at all and the error message is "Run Time Error '457' This key is already associated with an element of this collection." The error yellow box has highlighted on on the line "NoDupes.Add Cell.Value, CStr(Cell.Value)".

This happen to my coding as well. Sometimes the user form which hold my combobox COULD BE INITIALIZE SMOOTHLY, and sometimes IT COULD NOT.
The SAME error message pop up by placing the same line in YELLOW BOX.

Here is my coding:-

Private Sub UserForm_Initialize()

Dim rngTable As Range
Dim rngCell As Range
Dim NoDupes As New Collection
Dim intI As Integer
Dim intJ As Integer
Dim Swap1, Swap2, Item
Dim AllSheets As Worksheet

For Each AllSheets In ActiveWorkbook.Worksheets
Set rngTable = AllSheets.Range("A4:A" & AllSheets.Cells(Rows.Count, "A").End(xlUp).Row)

On Error Resume Next

For Each rngCell In rngTable
If rngCell.Value <> "TOTALS" Then

NoDupes.Add rngCell.Value, CStr(rngCell.Value)

End If

Next rngCell

On Error GoTo 0

Next AllSheets

'Sort the collection
For intI = 1 To NoDupes.Count - 1
For intJ = intI + 1 To NoDupes.Count
If NoDupes(intI) &gt; NoDupes(intJ) Then
Swap1 = NoDupes(intI)
Swap2 = NoDupes(intJ)
NoDupes.Add Swap1, before:=intJ
NoDupes.Add Swap2, before:=intI
NoDupes.Remove intI + 1
NoDupes.Remove intJ + 1
End If

Next intJ

Next intI

'Add the sorted, non-duplicated items to a comboBox
For Each Item In NoDupes

frmTotalInvoiceServiceID.cboGenerateSelectServiceID.AddItem Item

Next Item

End Sub

Really hope that you could help me on this. Thank you.

Regards,
the7Signals

Richie,

I attached my coding for your reference (Analysis.xls).

Hope you could help me solve my problem.

Thank you.

Regards

Richie,

Thank you for your replpy.

Prior to this, when I run my coding and your sample workbook in Microsoft Office XP and Microsoft Windows XP, it can run smoothly.

When I run my coding and your sample workbook in my home PC (in Microsoft Office 98 and Microsoft Windows 98 platform), the error occur.

Regards