PDA

View Full Version : Array to fill combobox



crender2000
06-22-2012, 03:06 AM
Here is what I want to do. I want the user to be able to type run into the textbox. Then when they hit tab or go to the combobox it will automatically populate the combobox with 7 9 or hello. Basically I want what ever the user types to be what the code looks for and then gives a result based on the match either a few cells to the left or a few cells to the right. Also, the sheet may be 50 lines long one day and 500 the next. I have done something similar with arrays. For some reason having a time adapting to this.

Also, can you show me how you would go the left of the match.

Right now it works for showing one match in the combobox. I need it to show all matches.




Private Sub CommandButton1_Click()
Dim LastRow As Object
Set LastRow = Sheet2.Range("a65536").End(xlUp)
LastRow.Offset(1, 0).Value = TextBox1.Text
MsgBox "One record written to Sheet3"
MsgBox "Do you want to enter another record?", vbYesNo

If vbYes Then
TextBox1.Text = ""
TextBox1.SetFocus

Else
Unload Me
End If

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.Value = Application.VLookup(Me.TextBox1, Sheets("Sheet1").Range("i:m"), 5, False)

End Sub

CodeNinja
06-22-2012, 08:50 AM
Crender2000,
You are close... the line "If VbYes Then" is definitely screwing you up... this will always be true... so you need to dim a string and do the following:

dim str as string
str = msgbox("Do you want to enter another record",vbyesno)
if str = vbyes then...


that looks more like this:

Private Sub CommandButton1_Click()
Dim LastRow As Object
Dim str As String

Set LastRow = Sheet2.Range("a65536").End(xlUp)
LastRow.Offset(1, 0).Value = TextBox1.Text
MsgBox "One record written to Sheet3"
str = MsgBox("Do you want to enter another record?", vbYesNo)


If str = vbYes Then
TextBox1.Text = ""
TextBox1.SetFocus
Else
Unload Me
End If

End Sub

Kenneth Hobs
06-22-2012, 09:10 AM
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With ComboBox1
Dim r As Range, c As Range
Set r = FoundRanges(Worksheets("Sheet1").Range("I1", Worksheets("Sheet1").Range("I" & Rows.Count).End(xlUp)), TextBox1.Value)
If r Is Nothing Then Exit Sub
.Clear
For Each c In r
.AddItem c.Offset(, 4)
Next c
End With
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function

crender2000
06-22-2012, 12:09 PM
Your code works great but it returns the wrong result for the first word in the list.

How does the functions found ranges get the values and pass it up to the textbox exit event. I am jsut trying to understand your code so I can adapt it to what I need at work. Also, I understand that range for r is column i. What is the range for c. I guess I really do not understand ranges that well.

Kenneth Hobs
06-22-2012, 12:19 PM
Since I am lazy, r means range and c means cell. So, for each cell in the found range, add the item offset by 4 columns from each of the found cells in the range that was found.

If you want exact order:
Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells((fRange.Rows.Count), fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function

crender2000
06-22-2012, 12:30 PM
The code is almost perfect. Thank you for you help. You are much better than I am. Do you have any suggestions for books I could read. I took VBA in college a year ago and did not learn that much. Did not think I would need it again and now my work wants me to try and write some programs. We have no one that really knows it that well.

Kenneth Hobs
06-22-2012, 03:04 PM
John Walkenbach's books tend to be good. http://spreadsheetpage.com/

Some of the MVP sites are good sources. http://www.mvps.org/links.html#Excel

Of course forums like this give you more direct help.