'searchable comboboxes
'sheet's name where the list (for combobox) is located.
Private Const sList As String = "Data"
'row where the list start
Private Const rCell As Long = 2
'range to use the combobox
Private Const xCell As String = "F5,F6,F7,F8,F21,F24,F40,F64,F79,F80,F82,F90,F91,F93,F95,F97,F99,F104,F105,F106,F107,F108,F113,F116,F118,F130,F133,F134,F158,F160,F162," & _
"G5,G6,G7,G8,G21,G24,G40,G64,G79,G80,G82,G90,G91,G93,G95,G97,G99,G104,G105,G106,G107,G108,G113,G116,G118,G130,G133,G134,G158,G160,G162," & _
"H5,H6,H7,H8,H21,H24,H40,H64,H79,H80,H82,H90,H91,H93,H95,H97,H99,H104,H105,H106,H107,H108,H113,H116,H118,H130,H133,H134,H158,H160,H162," & _
"I5,I6,I7,I8,I21,I24,I40,I64,I79,I80,I82,I90,I91,I93,I95,I97,I99,I104,I105,I106,I107,I108,I113,I116,I118,I130,I133,I134,I158,I160,I162," & _
"J5,J6,J7,J8,J21,J24,J40,J64,J79,J80,J82,J90,J91,J93,J95,J97,J99,J104,J105,J106,J107,J108,J113,J116,J118,J130,J133,J134,J158,J160,J162," & _
"K5,K6,K7,K8,K21,K24,K40,K64,K79,K80,K82,K90,K91,K93,K95,K97,K99,K104,K105,K106,K107,K108,K113,K116,K118,K130,K133,K134,K158,K160,K162," & _
"L5,L6,L7,L8,L21,L24,L40,L64,L79,L80,L82,L90,L91,L93,L95,L97,L99,L104,L105,L106,L107,L108,L113,L116,L118,L130,L133,L134,L158,L160,L162," & _
"M5,M6,M7,M8,M21,M24,M40,M64,M79,M80,M82,M90,M91,M93,M95,M97,M99,M104,M105,M106,M107,M108,M113,M116,M118,M130,M133,M134,M158,M160,M162," & _
"N5,N6,N7,N8,N21,N24,N40,N64,N79,N80,N82,N90,N91,N93,N95,N97,N99,N104,N105,N106,N107,N108,N113,N116,N118,N130,N133,N134,N158,N160,N162," & _
"O5,O6,O7,O8,O21,O24,O40,O64,O79,O80,O82,O90,O91,O93,O95,O97,O99,O104,O105,O106,O107,O108,O113,O116,O118,O130,O133,O134,O158,O160,O162," & _
"P5,P6,P7,P8,P21,P24,P40,P64,P79,P80,P82,P90,P91,P93,P95,P97,P99,P104,P105,P106,P107,P108,P113,P116,P118,P130,P133,P134,P158,P160,P162," & _
"Q5,Q6,Q7,Q8,Q21,Q24,Q40,Q64,Q79,Q80,Q82,Q90,Q91,Q93,Q95,Q97,Q99,Q104,Q105,Q106,Q107,Q108,Q113,Q116,Q118,Q130,Q133,Q134,Q158,Q160,Q162," & _
"R5,R6,R7,R8,R21,R24,R40,R64,R79,R80,R82,R90,R91,R93,R95,R97,R99,R104,R105,R106,R107,R108,R113,R116,R118,R130,R133,R134,R158,R160,R162," & _
"S5,S6,S7,S8,S21,S24,S40,S64,S79,S80,S82,S90,S91,S93,S95,S97,S99,S104,S105,S106,S107,S108,S113,S116,S118,S130,S133,S134,S158,S160,S162," & _
"T5,T6,T7,T8,T21,T24,T40,T64,T79,T80,T82,T90,T91,T93,T95,T97,T99,T104,T105,T106,T107,T108,T113,T116,T118,T130,T133,T134,T158,T160,T162," & _
"U5,U6,U7,U8,U21,U24,U40,U64,U79,U80,U82,U90,U91,U93,U95,U97,U99,U104,U105,U106,U107,U108,U113,U116,U118,U130,U133,U134,U158,U160,U162," & _
"V5,V6,V7,V8,V21,V24,V40,V64,V79,V80,V82,V90,V91,V93,V95,V97,V99,V104,V105,V106,V107,V108,V113,V116,V118,V130,V133,V134,V158,V160,V162," & _
"W5,W6,W7,W8,W21,W24,W40,W64,W79,W80,W82,W90,W91,W93,W95,W97,W99,W104,W105,W106,W107,W108,W113,W116,W118,W130,W133,W134,W158,W160,W162," & _
"X5,X6,X7,X8,X21,X24,X40,X64,X79,X80,X82,X90,X91,X93,X95,X97,X99,X104,X105,X106,X107,X108,X113,X116,X118,X130,X133,X134,X158,X160,X162," & _
"Y5,Y6,Y7,Y8,Y21,Y24,Y40,Y64,Y79,Y80,Y82,Y90,Y91,Y93,Y95,Y97,Y99,Y104,Y105,Y106,Y107,Y108,Y113,Y116,Y118,Y130,Y133,Y134,Y158,Y160,Y162," & _
"Z5,Z6,Z7,Z8,Z21,Z24,Z40,Z64,Z79,Z80,Z82,Z90,Z91,Z93,Z95,Z97,Z99,Z104,Z105,Z106,Z107,Z108,Z113,Z116,Z118,Z130,Z133,Z134,Z158,Z160,Z162"
'offset from xCell where the cursor go after leaving the combobox
' 1 means 1 column to the right of xCell
Private Const ofs As Long = 1
'================================================================================================
Private ary
Private arz
'=================================================================================================
Private Sub ComboBox1_GotFocus()
With ComboBox1
.MatchEntry = fmMatchEntryNone
.Value = ""
End With
'split from Data validation
ary = Split(xCell, ",") ' cells where the combobox is located
arz = Split("E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV," & _
"E,F,E,F,AH,AI,AH,AK,AJ,I,J,K,L,M,O,P,I,S,T,U,V,W,AI,AL,AM,AH,AB,AH,AT,AU,AV", ",") ' columns where the list as the source of the combobox is located
'--------------------------------------------------------------------
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13 'Enter
'Enter Key to fill the cell with combobox value
Dim x As String, fm, vlist2
With Sheets(sList)
' x = Split(ActiveCell.Address, "$")(1)
x = ActiveCell.Address(0, 0)
fm = Application.Match(x, ary, 0) - 1
x = arz(fm)
vlist2 = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
End With
If IsError(Application.Match(ComboBox1.Value, vlist2, 0)) Then
If Len(ComboBox1.Value) = 0 Then
ActiveCell = ""
Else
MsgBox "Wrong input", vbCritical
End If
Else
ActiveCell = ComboBox1.Value
ActiveCell.Offset(ofs).Activate
End If
Case 27, 9 'esc 'tab
ComboBox1.Clear
'
ActiveCell.Offset(ofs).Activate
Case Else
'do nothing
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if selection is in a certain range (xCell) then Call toShowCombobox
If Not Intersect(Range("xCombo"), Target) Is Nothing And Target.CountLarge = 1 Then
Call toShowCombobox
Else
ComboBox1.Visible = False
End If
End Sub
Sub toShowCombobox()
Dim Target As Range
Set Target = ActiveCell
' if selection is in a certain range (xCell) then show combobox
If Not Intersect(Range("xCombo"), Target) Is Nothing And Target.CountLarge = 1 Then
'setting up combobox property
With ComboBox1
.Height = Target.Height + 5
.Width = Target.Width + 10
.Top = Target.Top - 2
.Left = Target.Offset(0, 0).Left
' .Left = Target.Left
.Visible = True
.Value = ""
.Activate
End With
Else
ComboBox1.Visible = False
End If
End Sub
Private Sub ComboBox1_LostFocus()
' If selection is still in this sheet
If Selection.Worksheet.Name = Me.Name Then
Call toShowCombobox
End If
End Sub
''using "System.Collections.ArrayList" to sort list
Private Sub ComboBox1_Change()
Dim dar As Object, vlist2, i As Long
Dim x As String, fm
With Sheets(sList)
' x = Split(ActiveCell.Address, "$")(1)
x = ActiveCell.Address(0, 0)
fm = Application.Match(x, ary, 0) - 1
x = arz(fm)
vlist2 = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
End With
With ComboBox1
If .Value <> "" And IsError(Application.Match(.Value, vlist2, 0)) Then
Set dar = CreateObject("System.Collections.ArrayList")
For i = LBound(vlist2) To UBound(vlist2)
'Use this for search patern: word*word*
' If LCase(vList2(i, 1)) Like Replace(LCase(.Value), " ", "*") & "*" Then
'Use this for search patern: *word*word*
If LCase(vlist2(i, 1)) Like "*" & Replace(LCase(.Value), " ", "*") & "*" Then
If Not dar.Contains(vlist2(i, 1)) And vlist2(i, 1) <> "" Then
dar.Add vlist2(i, 1)
End If
End If
Next
dar.Sort
.List = dar.Toarray()
.DropDown
End If
End With
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim vList, dar As Object, i As Long
With ComboBox1
If .Value = vbNullString Then
Dim x As String, fm
With Sheets(sList)
' x = Split(ActiveCell.Address, "$")(1)
x = ActiveCell.Address(0, 0)
fm = Application.Match(x, ary, 0) - 1
x = arz(fm)
vList = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
End With
' vList = Sheets(sList).Range(sCell, Sheets(sList).Cells(Rows.Count, sCol).End(xlUp)).Value
Set dar = CreateObject("System.Collections.ArrayList")
For i = LBound(vList) To UBound(vList)
'make the list unique & has no blank
If Not dar.Contains(vList(i, 1)) And vList(i, 1) <> "" Then
dar.Add vList(i, 1)
' dar.Add CStr(vList(i, 1))
End If
Next
'sort the list
dar.Sort
.List = dar.Toarray()
.DropDown
End If
End With
End Sub
Sub to_xName()
Dim c As Range
For Each x In Split(xCell, ",")
If c Is Nothing Then
Set c = Range(x)
Else
Set c = Union(c, Range(x))
End If
Next
ThisWorkbook.Names.Add Name:="xCombo", RefersTo:=c
End Sub