PDA

View Full Version : Solved: Form-Filling GUI: ComboBox problem



Chisholm
07-14-2008, 12:46 PM
Hi all, I'm trying to create a user form which copies text from text boxes and places them in the appropriate columns of the last row in the sheet.
A problem arises when I try to add a combobox to the form... I used modified version of the KB article:
Address: "http://www.vbaexpress.com/kb/getarticle.php?kb_id=824"
Title: "Fill combobox with ordered list"
I've got the box and form to function, however a problem remains with the combobox.
The combobox is listing the contents of the named range that i'm using, except it is repeating duplicate entries, something that it looks like it was designed not to do.
Here's the VBA code I've compiled thus far:

'Place all code in the Userform
Option Explicit

Dim FArray()
Dim DataList As Range
Dim MyList As String

Private Sub UserForm_Initialize()
Dim Found As Long, i As Long
Dim cel As Range

'Set Range Name to suit
MyList = "Bid_To"

Set DataList = Range(MyList)
ReDim FArray(DataList.Cells.Count)
i = -1

For Each cel In DataList
On Error Resume Next
Found = Application.WorksheetFunction.Match(CStr(cel), FArray, 0)
If Found > 0 Then GoTo Exists
i = i + 1
FArray(i) = cel
Exists:
Found = 0
Next
ReDim Preserve FArray(i)
Call BubbleSort(FArray)
ComboBox1.ListRows = i + 1
ComboBox1.List() = FArray
End Sub

Private Sub ComboBox1_AfterUpdate()
Dim MyAdd As String
Dim Found As Long

On Error Resume Next
Found = Application.WorksheetFunction.Match(ComboBox1, FArray, 0)
If Found > 0 Then
DoEvents
Else
DataList.End(xlDown).Offset(1) = ComboBox1
Set DataList = Union(DataList, DataList.End(xlDown))
MyAdd = "=" & ActiveSheet.Name & "!" & DataList.Address
ActiveWorkbook.Names.Add Name:=MyList, _
RefersTo:=MyAdd
End If
End Sub

Private Sub CommandButton1_Click()
Cells(Cells.Rows.Count, 4).End(xlUp).Offset(1) = ComboBox1
Set DataList = Nothing
Unload UserForm1
End Sub

Sub BubbleSort(MyArray As Variant)

Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As String
Dim List As String

First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For j = i + 1 To Last
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i
End Sub


Private Sub cmd_add_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Fixed Sheet")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a part number
If Trim(Me.txt_job.Value) = "" Then
Me.txt_job.SetFocus
MsgBox "Please enter a Job"
Exit Sub
End If

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txt_date.Value
ws.Cells(iRow, 2).Value = Me.txt_bid.Value
ws.Cells(iRow, 3).Value = Me.txt_job.Value
ws.Cells(iRow, 4).Value = Me.txt_total.Value
ws.Cells(iRow, 5).Value = Me.txt_est1.Value
ws.Cells(iRow, 6).Value = Me.txt_est2.Value
ws.Cells(iRow, 7).Value = Me.txt_status.Value
ws.Cells(iRow, 8).Value = Me.txt_gross.Value
ws.Cells(iRow, 11).Value = Me.txt_site.Value
ws.Cells(iRow, 12).Value = Me.txt_type.Value


'clear the data
Me.txt_date.Value = ""
Me.txt_bid.Value = ""
Me.txt_job.Value = ""
Me.txt_total.Value = ""
Me.txt_est1.Value = ""
Me.txt_est2.Value = ""
Me.txt_status.Value = ""
Me.txt_gross.Value = ""
Me.txt_site.Value = ""
Me.txt_job.Value = ""
Me.txt_date.SetFocus

End Sub



Private Sub cmd_close_Click()




Unload Me



End Sub

Private Sub UserForm_Click()

End Sub

I've included a sample spreadsheet, which doesn't have the original dataset I'm using, and doesn't have the correct userform, but it does reproduce the problem.

Chisholm
07-14-2008, 12:58 PM
To clarify, I want the combo-box to list all unique entries from the appropriate column (or range), without spaces betweeen them.

mdmackillop
07-14-2008, 01:33 PM
Time to update that item!


Private Sub UserForm_Initialize()
Dim Found As Long
Dim cel As Range
Dim a, d, i As Long

Set d = CreateObject("Scripting.Dictionary")

On Error Resume Next
For Each cel In Range("Bid_To")
d.Add CStr(cel), CStr(cel)
Next
On Error GoTo 0

a = d.items

Call BubbleSort(a)
ComboBox1.ListRows = i + 1
ComboBox1.List() = a
End Sub

mdmackillop
07-14-2008, 01:38 PM
BTW,
You probably don't want to process 65536 cells, so limit the range to the data range.

Chisholm
07-14-2008, 01:43 PM
Thanks for the reply, md.
I'm not quite sure what my original problem was (i.e.- update) and how to use your solution.
I've tried copying and pasting into the code, and replacing the other "user_form initialize" section.

mdmackillop
07-14-2008, 01:52 PM
Can you post your userform with sample data?

Chisholm
07-15-2008, 07:11 AM
Give me a little bit, and I'll have that up.

Chisholm
07-15-2008, 07:49 AM
'Place all code in the Userform
Option Explicit

Dim FArray()
Dim DataList As Range
Dim MyList As String

Private Sub UserForm_Initialize()
Dim Found As Long, i As Long
Dim cel As Range

'Set Range Name to suit
MyList = "Data"

Set DataList = Range(MyList)
ReDim FArray(DataList.Cells.Count)
i = -1

For Each cel In DataList
On Error Resume Next
Found = Application.WorksheetFunction.Match(CStr(cel), FArray, 0)
If Found > 0 Then GoTo Exists
i = i + 1
FArray(i) = cel
Exists:
Found = 0
Next
ReDim Preserve FArray(i)
Call BubbleSort(FArray)
ComboBox1.ListRows = i + 1
ComboBox1.List() = FArray
End Sub

Private Sub ComboBox1_AfterUpdate()
Dim MyAdd As String
Dim Found As Long

On Error Resume Next
Found = Application.WorksheetFunction.Match(ComboBox1, FArray, 0)
If Found > 0 Then
DoEvents
Else
DataList.End(xlDown).Offset(1) = ComboBox1
Set DataList = Union(DataList, DataList.End(xlDown))
MyAdd = "=" & ActiveSheet.Name & "!" & DataList.Address
ActiveWorkbook.Names.Add Name:=MyList, _
RefersTo:=MyAdd
End If
End Sub

Private Sub CommandButton1_Click()
Cells(Cells.Rows.Count, 4).End(xlUp).Offset(1) = ComboBox1
Set DataList = Nothing
Unload UserForm1
End Sub

Sub BubbleSort(MyArray As Variant)

Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As String
Dim List As String

First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For j = i + 1 To Last
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i
End Sub

I used this sample of data with a userform that has only a combox1 and command button. It seems to work okay, as long as I'm careful about my named ranges.
I suppose I can get it to work if I just limit my named range from say, row 2:3000, since I think that I can expect the list to not grow very fast. Doing this makes the list compress and behave appropriately. If I name the entire column, it behaves all screwy and gives me this really long list with repeats and blank spots. I tried something else, and that gave me a nice list accompanied by an almost an entire screens length of empty rows.
I'm not complaining about the code, just reflecting on my experiences.

Oh, and I was not able to figure out how to post the userform.

Well, I guess I could just keep the range rather small==>Job Security!
:whip

mdmackillop
07-15-2008, 12:31 PM
Combobox Sample