Multiple ComboBoxes based on same dynamic Data- Help.

[JaveCidem]

Good day,
I'm developing an order form for my workplace. I initially used DropDowns (Data Validation Method); however, upon trailing the form, our staff found it hard to scroll through an inventory list of 400 items.
Last night I searched and found an answer to searchable lists: ActiveXComboBox! So instead of having 40 rows of dropdown lists, I have 40 ComboBoxes. The order form in on the mainsheet, and the data source is on the 2nd sheet (which I have protected and hide from the users).

Here is my problem: I want the comboboxes to be linked to the same table and use the same helper columns to retrieve the right data without creating 3 helper columns x 40 comboboxes (which are all based on the same Master Table.

These are my helper column formulas:

• (If Found Column is in "S"): =--isnumber(search('Sheet2'!$B$11, TableMaster[Products]))
• (Frequency Column is in "T") =if(S4:S400=1, COUNTIF($S$4:$S4,1),"")
• (Search helper Column is in "U") =IFERROR(INDEX(TableMaster[Products],MATCH(ROWS($T$4:$T4),$T$4:$T$400,0)),"")
• I've named my Range for ComboBox1 as SearchBox1. This is the formula I've used: =Sheet2!$U$4:INDEX(SHEET2!$U$4:$U$400,COUNTIF(SHEET2!$U$4:$U$400, "?*"))

Please Note that this works for ComboBox1

Ideally, I would like all 40 ComboBoxes to be able to use the three aforementioned Helper Columns and MasterTable - without re-creating 120 Columns for the 40 ComboBoxes.

OR is there a way to "Stamp" or select a product item from one comboBox and have it "punch" or be pasted into a cell. Then move to the next row (same column)?

The goal is to make this order form easy to use, which is why I needed the search field in the product item cells. This will allow the staff to start typing what they think the product is called and it will return the value of all items with the searched work. Example, "Tape" (options Transport, Mircopore Tape, etc.)

I have take 4 days of excel training. I am a Military Medic who has been placed into the role of SupplyTech. I have little experience with Excel; however, I have been consumed with this project and have been working 7 days a week to get our Medical Stores Position Turned around and with complete transparency. It's scary how much stuff "disappears" or wasted products (mass ordering - expired prior to use).

Thank you Excel Friend in advanced. I am here to learn and grow.

Dave
Cidem is Medic Backwards FYI.

 

[My Aswer Is This]

This script will search for the value selected in a combobox.
It will search column "A"
If found it will put the value "Me" into column "C" next to the search word.

Private Sub CommandButton2_Click()
Dim SearchString As String
Dim SearchRange As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
SearchString = ComboBox1.Value
Set SearchRange = Range("A2:A" & Lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox SearchString & "  Not found": Exit Sub
SearchRange.Offset(0, 2).Value = "Me"
End Sub

 

[Fazza]

Hi, Dave

Some old code that may help a little.

It used to have mouse wheel scrolling & somewhere over the years that stopped working & I just commented it out of the code without fixing it.

Typically I have it triggered by a right click from the column that will be populated with the returned selection. Simple example on the worksheet to be populated

This assumes that the lookup table of data is on Sheet2.range("A2:C5"). Obviously change to suit.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    Dim arInputTable As Variant
    
     If Target.Column = 5 Then
        Cancel = True
        arInputTable = Sheet2.Range("A2:C5").Value 'data table that is being looked up / selected from.
        Call InputViaUserformType1(Target:=Target.Cells(1), MyInputList:=arInputTable, sColumnWidths:="50;200;50", lFilterColumn:=2)
     End If


End Sub

Then there is a user form called ufUserInputType1

It has
- a big list box called lb_Data_Items This will show the lookup table and will be filtered as changes are made in ...
- a small text box called txtFilterBox This is where the user enters text to filter the big list box. Next to it on the LHS is ...
- a small label called lblFilter This just says "Filter for" so the user knows to enter text into txtFilterBox
- there are also buttons called btn_OK and btn_CANCEL

The code that is with the user form is

Option Explicit

Dim mblnListHasOnlyOneItem As Boolean
'for capturing the mouse wheel in the list box
'===================================
'copied from http://www.xtremevbtalk.com/showthread.php?p=812821#post798072
'===================================


Private Sub lb_Data_Items_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 var_uf_output = ufUserInputType1.lb_Data_Items.Value
 Unload ufUserInputType1
End Sub


Private Sub UserForm_Activate()
 Set myUserForm = Me
 ''For scrolling support
 '    WheelHook Me
 mblnListHasOnlyOneItem = myUserForm.lb_Data_Items.ListCount = 1
End Sub


Private Sub UserForm_Initialize()
 Application.ScreenUpdating = True
End Sub


'Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
''For scrolling support
'    WheelUnHook
'End Sub
'
'Private Sub UserForm_Deactivate()
''For scrolling support
'    WheelUnHook
'
'End Sub


Public Sub MouseWheel(ByVal Rotation As Long)
 '************************************************
 ' To respond from MouseWheel event
 ' Scroll accordingly to direction
 '
 ' Made by:  Mathieu Plante
 ' Date:     July 2004
 '************************************************
 If Rotation > 0 Then
  'Scroll up
  If lb_Data_Items.TopIndex > 0 Then
   If lb_Data_Items.TopIndex > 3 Then
    lb_Data_Items.TopIndex = lb_Data_Items.TopIndex - 3
   Else
    lb_Data_Items.TopIndex = 0
   End If
  End If
 Else
  'Scroll down
  lb_Data_Items.TopIndex = lb_Data_Items.TopIndex + 3
 End If
End Sub


'=====================================
'=====================================


Private Sub btn_CANCEL_Click()
 Unload ufUserInputType1
End Sub


Private Sub btn_OK_Click()
 var_uf_output = ufUserInputType1.lb_Data_Items.Value
 Unload ufUserInputType1
End Sub


Private Sub txtFilterBox_Change()
 Application.EnableEvents = False
 Application.ScreenUpdating = False
 If mblnListHasOnlyOneItem Then
  MsgBox prompt:="Filtering not available with only one item in the list.", Buttons:=vbOKOnly, Title:="Filtering Unavailable"
 Else
  Call FilterListBox(sTextFilter:=txtFilterBox.Value, lFilterColumn:=lng_uf_filter_column, TheListBox:=ufUserInputType1.lb_Data_Items)
 End If
 Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub


Private Sub UserForm_Terminate()
 Application.ScreenUpdating = True
End Sub


Private Sub FilterListBox(ByRef sTextFilter As String, ByRef lFilterColumn As Long, ByRef TheListBox As Object)
 'Global var_uf_input stores the unchanged/unfiltered full list of options that populate the list box.
 'This routine loops through that full list of codes & creates a new array of the wanted filtered records.
 
 Dim i As Long, j As Long, k As Long
 Dim arOut As Variant
 
 arOut = var_uf_input
 
 If Len(sTextFilter) = 0 Then
  'when there is no filter string in the input box, show the entire list
  With TheListBox
   For i = LBound(arOut, 1) To UBound(arOut, 1) 'this array is 1-based, list box is 0-based
    .AddItem
    .List(i - 1, 0) = arOut(i, 1)
    .List(i - 1, 1) = arOut(i, 2)
   Next i
  End With
  
 Else 'When there is a filter string
  For i = LBound(var_uf_input, 1) To UBound(var_uf_input, 1)
   If InStr(1, var_uf_input(i, lFilterColumn), sTextFilter, vbTextCompare) Then
    k = k + 1
    For j = LBound(var_uf_input, 2) To UBound(var_uf_input, 2)
     arOut(k, j) = var_uf_input(i, j)
    Next j
   End If
  Next i
  'Now have list of wanted filtered entries in arOut
  With TheListBox
   .Clear
   If k > 0 Then
    For i = LBound(arOut, 1) To k 'this array is 1-based, list box is 0-based
     .AddItem
     .List(i - 1, 0) = arOut(i, 1)
     .List(i - 1, 1) = arOut(i, 2)
    Next i
   End If
  End With
 End If
 
End Sub

In a normal code module is this code,

Option Explicit


Public lng_uf_filter_column As Long
    
Public var_uf_input As Variant
Public var_uf_output As Variant
    
Public myUserForm As Object


Public Sub InputViaUserformType1(ByRef Target As Excel.Range, ByRef MyInputList As Variant, ByRef sColumnWidths As String, ByVal lFilterColumn As Long)
 '-------------------------------------------------------------------------
 ' Note separator in ColumnWidths input string needs to be like "50;200"
 '
 ' Global variable var_uf_input stores the array of inputs - available to the userform when filtering for subsets of the original/full data.
 ' Global variable lng_uf_filter_column identifies which column of the array is to be filtered.
 ' Global variable var_uf_output stores the value (the user's selection) returned from the user form.
 '-------------------------------------------------------------------------
 
 Dim i As Long, j As Long
 
 lng_uf_filter_column = lFilterColumn
 var_uf_input = MyInputList
 var_uf_output = Target.Value
 
 With ufUserInputType1
  
  With .lb_Data_Items
   .BoundColumn = 1
   .ColumnCount = UBound(MyInputList, 2) 'how many columns to show
   .ColumnHeads = False 'show the header row from above the source data
   .ColumnWidths = sColumnWidths
   '-------------------------
   'Loop through each row of source array & initialise listbox entries
   For i = LBound(MyInputList, 1) To UBound(MyInputList, 1) 'this array is 1-based, list box is 0-based
    .AddItem
    'loop through each column/field of source array
    For j = LBound(MyInputList, 2) To UBound(MyInputList, 2) 'this array is 1-based, list box is 0-based
     .List(i - 1, j - 1) = MyInputList(i, j)
    Next j
   Next i
   '-------------------------
   .MultiSelect = fmMultiSelectSingle 'whether can select one or many choices
   .ListStyle = fmListStyleOption 'whether or not there is a check box
   On Error Resume Next
   .Value = Target.Value
   On Error GoTo 0
  End With
  
  .StartUpPosition = 0
  .Left = Application.Left + (Application.Width - .Width) \ 2
  .Top = Application.Top + (Application.Height - .Height) \ 2
  
  .Show
  
 End With
 
 If IsNumeric(var_uf_output) Or IsNull(var_uf_output) Then
  Target.Value = var_uf_output
 Else
  Target.Value = "'" & CStr(var_uf_output)
 End If
 
 Unload ufUserInputType1
 
End Sub

HTH. regards

 

[JaveCidem]

Hi guys,
I just got home from work and am starting to look at your replies. Thank you VERY much. I am going to start playing with these.

Dave