Excel 2010: how to use autocomplete in validation list - vba

I'm using a large validation list on which a couple of vlookup() functions depend. This list is getting larger and larger. Is there a way to type the first letters of the list item I'm looking for, instead of manually scrolling down the list searching for the item?
I've done some Googling but this suggests that this is indeed possible in earlier versions of Excel, but not in Excel 2010. Hope you guys can help.

Here is a very good way to handle this (found on ozgrid):
Let's say your list is on Sheet2 and you wish to use the Validation List with AutoComplete on Sheet1.
On Sheet1 A1 Enter =Sheet2!A1 and copy down including as many spare rows as needed (say 300 rows total). Hide these rows and use this formula in the Refers to: for a dynamic named range called MyList:
=OFFSET(Sheet1!$A$1,0,0,MATCH("*",Sheet1!$A$1:$A$300,-1),1)
Now in the cell immediately below the last hidden row use Data Validation and for the List Source use =MyList
[EDIT] Adapted version for Excel 2007+ (couldn't test on 2010 though but AFAIK, there is nothing really specific to a version).
Let's say your data source is on Sheet2!A1:A300 and let's assume your validation list (aka autocomplete) is on cell Sheet1!A1.
Create a dynamic named range MyList that will depend on the value of the cell where you put the validation
=OFFSET(Sheet2!$A$1,MATCH(Sheet1!$A$1&"*",Sheet2!$A$1:$A$300,0)-1,0,COUNTA(Sheet2!$A:$A))
Add the validation list on cell Sheet1!A1 that will refert to the list =MyList
Caveats
This is not a real autocomplete as you have to type first and then click on the validation arrow : the list will then begin at the first matching element of your list
The list will go till the end of your data. If you want to be more precise (keep in the list only the matching elements), you can change the COUNTA with a SUMLPRODUCT that will calculate the number of matching elements
Your source list must be sorted

Here's another option. It works by putting an ActiveX ComboBox on top of the cell with validation enabled, and then providing autocomplete in the ComboBox instead.
Option Explicit
' Autocomplete - replacing validation lists with ActiveX ComboBox
'
' Usage:
' 1. Copy this code into a module named m_autocomplete
' 2. Go to Tools / References and make sure "Microsoft Forms 2.0 Object Library" is checked
' 3. Copy and paste the following code to the worksheet where you want autocomplete
' ------------------------------------------------------------------------------------------------------
' - autocomplete
' Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' m_autocomplete.SelectionChangeHandler Target
' End Sub
' Private Sub AutoComplete_Combo_KeyDown(ByVal KeyCode As msforms.ReturnInteger, ByVal Shift As Integer)
' m_autocomplete.KeyDownHandler KeyCode, Shift
' End Sub
' Private Sub AutoComplete_Combo_Click()
' m_autocomplete.AutoComplete_Combo_Click
' End Sub
' ------------------------------------------------------------------------------------------------------
' When the combobox is clicked, it should dropdown (expand)
Public Sub AutoComplete_Combo_Click()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cbo As OLEObject: Set cbo = GetComboBoxObject(ws)
Dim cb As ComboBox: Set cb = cbo.Object
If cbo.Visible Then cb.DropDown
End Sub
' Make it easier to navigate between cells
Public Sub KeyDownHandler(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Const UP As Integer = -1
Const DOWN As Integer = 1
Const K_TAB_______ As Integer = 9
Const K_ENTER_____ As Integer = 13
Const K_ARROW_UP__ As Integer = 38
Const K_ARROW_DOWN As Integer = 40
Dim direction As Integer: direction = 0
If Shift = 0 And KeyCode = K_TAB_______ Then direction = DOWN
If Shift = 0 And KeyCode = K_ENTER_____ Then direction = DOWN
If Shift = 1 And KeyCode = K_TAB_______ Then direction = UP
If Shift = 1 And KeyCode = K_ENTER_____ Then direction = UP
If Shift = 1 And KeyCode = K_ARROW_UP__ Then direction = UP
If Shift = 1 And KeyCode = K_ARROW_DOWN Then direction = DOWN
If direction <> 0 Then ActiveCell.Offset(direction, 0).Activate
AutoComplete_Combo_Click
End Sub
Public Sub SelectionChangeHandler(ByVal Target As Range)
On Error GoTo errHandler
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cbo As OLEObject: Set cbo = GetComboBoxObject(ws)
Dim cb As ComboBox: Set cb = cbo.Object
' Try to hide the ComboBox. This might be buggy...
If cbo.Visible Then
cbo.Left = 10
cbo.Top = 10
cbo.ListFillRange = ""
cbo.LinkedCell = ""
cbo.Visible = False
Application.ScreenUpdating = True
ActiveSheet.Calculate
ActiveWindow.SmallScroll
Application.WindowState = Application.WindowState
DoEvents
End If
If Not HasValidationList(Target) Then GoTo ex
Application.EnableEvents = False
' TODO: the code below is a little fragile
Dim lfr As String
lfr = Mid(Target.Validation.Formula1, 2)
lfr = Replace(lfr, "INDIREKTE", "") ' norwegian
lfr = Replace(lfr, "INDIRECT", "") ' english
lfr = Replace(lfr, """", "")
lfr = Application.Range(lfr).Address(External:=True)
cbo.ListFillRange = lfr
cbo.Visible = True
cbo.Left = Target.Left
cbo.Top = Target.Top
cbo.Height = Target.Height + 5
cbo.Width = Target.Width + 15
cbo.LinkedCell = Target.Address(External:=True)
cbo.Activate
cb.SelStart = 0
cb.SelLength = cb.TextLength
cb.DropDown
GoTo ex
errHandler:
Debug.Print "Error"
Debug.Print Err.Number
Debug.Print Err.Description
ex:
Application.EnableEvents = True
End Sub
' Does the cell have a validation list?
Function HasValidationList(Cell As Range) As Boolean
HasValidationList = False
On Error GoTo ex
If Cell.Validation.Type = xlValidateList Then HasValidationList = True
ex:
End Function
' Retrieve or create the ComboBox
Function GetComboBoxObject(ws As Worksheet) As OLEObject
Dim cbo As OLEObject
On Error Resume Next
Set cbo = ws.OLEObjects("AutoComplete_Combo")
On Error GoTo 0
If cbo Is Nothing Then
'Dim EnableSelection As Integer: EnableSelection = ws.EnableSelection
Dim ProtectContents As Boolean: ProtectContents = ws.ProtectContents
Debug.Print "Lager AutoComplete_Combo"
If ProtectContents Then ws.Unprotect
Set cbo = ws.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=50, Top:=18.75, Width:=129, Height:=18.75)
cbo.name = "AutoComplete_Combo"
cbo.Object.MatchRequired = True
cbo.Object.ListRows = 12
If ProtectContents Then ws.Protect
End If
Set GetComboBoxObject = cbo
End Function

Building on the answer of JMax, use this formula for the dynamic named range to make the solution work for multiple rows:
=OFFSET(Sheet2!$A$1,MATCH(INDIRECT("Sheet1!"&ADDRESS(ROW(),COLUMN(),4))&"*",Sheet2!$A$1:$A$300,0)-1,0,COUNTA(Sheet2!$A:$A))

Excel automatically does this whenever you have a vertical column of items. If you select the blank cell below (or above) the column and start typing, it does autocomplete based on everything in the column.

As other people suggested, you need to use a combobox. However, most tutorials show you how to set up just one combobox and the process is quite tedious.
As I faced this problem before when entering a large amount of data from a list, I can suggest you use this autocomplete add-in . It helps you create the combobox on any cells you select and you can define a list to appear in the dropdown.

=OFFSET(NameList!$A$2:$A$200,MATCH(INDIRECT("FillData!"&ADDRESS(ROW(),COLUMN(),4))&"*",NameList!$A$2:$A$200,0)-1,0,COUNTIF($A$2:$A$200,INDIRECT("FillData!"&ADDRESS(ROW(),COLUMN(),4))&"*"),1)
Create sheet name as Namelist. In column A fill list of data.
Create another sheet name as FillData for making data validation list as you want.
Type first alphabet and select, drop down menu will appear depend on you type.

Related

Setting a VBA form object using a string

Hello,
I am trying to set up a form which is a calendar from which the user can select a date (by default the current month appears). The form consists of 42 command buttons (I have left the default name ie. CommandButton1) which I am setting the day number.
At the moment I have a long-winded section of code for each button (I used Excel to generate this rather than type it all out) which locks and hides the button if it is outside of the month in question which looks like this:
NewDate.CommandButton1.Caption = Format(DATlngFirstMonth - DATintDayNumFirst + DATintX, "dd")
If DATintX < DATintDayNumFirst Then
With NewDate.CommandButton1
.Locked = True
.Visible = DATbooShowExtraDays
.ForeColor = RGB(150, 150, 150)
End With
Else
With NewDate.CommandButton1
.Locked = False
.Visible = True
.ForeColor = RGB(0, 0, 0)
End With
End If
I know that I can refer to a command button by:
Dim objCommandButton As Object
Set objCommandButton = NewDate.CommandButton1
..which neatens the code up somewhat. But what I would like to do is refer to the command button as a string so I can loop through all 42, ie.
Dim n as integer
n = 1
Do Until n > 42
Set objCommandButton = NewDate.CommandButton & n
'Some operations
n = n + 1
Loop
Many thanks in advance for assistance.
You can loop through all controls of the form. Try
Sub LoopButtons()
Dim it As Object
For Each it In NewDate.Controls
Debug.Print it.Name
Next it
End Sub
Then you can put conditional expression (if ... then) in place of Debug.Print or whatever. For example
If Instr(it.Name, "CommandButton") Then
'do your code
end if
Here's code which iterates over ActiveX controls on active sheet:
Sub IterateOverActiveXControlsByName()
Dim x As Integer
Dim oleObjs As OLEObjects
Dim ctrl As MSForms.CommandButton
Set oleObjs = ActiveSheet.OLEObjects
For x = 1 To 10
Set ctrl = oleObjs("CommandButton" & x).Object
Next
End Sub

drop down list combo box excel

I have a searchable combo box with suggestions to select from as I type letters in it (vba below). However i want to be able to click the arrow of the combo box (if i don't type anything else in it of course) and see the entire drop down list. For some reason the code below does not show me the entire list if I click the arrow.
Any suggestions much appreciated.
Dim ws As Worksheet
Dim x, dict
Dim i As Long
Dim str As String
Set ws = Sheets("Lists")
x = ws.Range("Listing").value
Set dict = CreateObject("Scripting.Dictionary")
str = Me.cbo1.value
If str <> "" Then
For i = 1 To UBound(x, 1)
If InStr(LCase(x(i, 1)), LCase(str)) > 0 Then
dict.Item(x(i, 1)) = ""
End If
Next i
Me.cbo1.List = dict.keys
Else
Me.cbo1.List = x
End If
Me.cbo1.DropDown
What you want is that if the arrow is clicked when nothing is yet selected or written in the combo by the user, to show all the items of the list, which you load from the named range "Listing" without any filtering.
To do so, add this event handler to your userform's code:
Private Sub Cbo1_DropButtonClick()
'If Len(Trim(cbo1.text)) = 0 Then
If Trim(cbo1.text) = "type here" Then
cbo1.List = Sheets("Lists").Range("Listing").Value
Exit Sub
End If
' Your code to add only items that match the characters typed by the user
' ...
End Sub

Excel: How to retrieve the frozen range of the Worksheet programmatically?

I'm using VSTO to build an Excel add-in.
I want to build two functions. The first one, stores the frozen range at my Excel.Range variable called RNG and then unfreeze panes, using the following command.
Globals.ThisAddIn.Application.ActiveWindow.FreezePanes = False
The second function selects the range and freezes it again. With the following
RNG.Select()
Globals.ThisAddIn.Application.ActiveWindow.FreezePanes = True
What i don't know is how to store the frozen range before unfreeze the window.
Does someone can help me with doing this, or knows some other workaround?
Thanks.
With #Byron 's help, I solved my problem. Here is my code!
'Flag that indicates if there is a "frozen" scenario stored in the other variables
Private frozen_scenario As Boolean
'Range that marks the first cell of the frozen header
Private range_freeze_begin As Excel.Range
'Range that marks the the first cell not contained by the frozen header
Private range_freeze_end As Excel.Range
'Range that marks the the first visible cell (in the not fixed pane)
Private first_visible_cell_not_fixed As Excel.Range
'Unfreezes the panes, saving the current scenario
Private Sub unfreezeLines()
With Globals.ThisAddIn.Application.ActiveWindow
If .FreezePanes Then
Dim frozen_pane_limit_line As Integer
Dim frozen_pane_limit_column As Integer
frozen_pane_limit_line = .Panes(1).VisibleRange.Rows.Count + 1
frozen_pane_limit_column = .Panes(1).VisibleRange.Columns.Count + 1
If .Panes.Count = 2 Then
If .Panes(1).VisibleRange(1, 1).Row = .Panes(2).VisibleRange(1, 1).Row Then
frozen_pane_limit_line = 1
Else
frozen_pane_limit_column = 1
End If
Me.first_visible_cell_not_fixed = .Panes(2).VisibleRange(1, 1)
Else '4 panes
Me.first_visible_cell_not_fixed = .Panes(4).VisibleRange(1, 1)
End If
Me.range_freeze_begin = .Panes(1).VisibleRange(1, 1)
Me.range_freeze_end = Me.sheet.Cells(frozen_pane_limit_line, frozen_pane_limit_column)
Me.frozen_scenario = True
.FreezePanes = False
End If
End With
End Sub
'Recovers the frozen state, exactly like it was when the first function was called
Private Sub recuperaLinhasCongeladas()
If Me.frozen_scenario Then
'Creating the frozen header again
Globals.ThisAddIn.Application.Goto(Me.range_freeze_begin, True)
Me.range_freeze_end.Select()
Globals.ThisAddIn.Application.ActiveWindow.FreezePanes = True
'Showing the same cell at the top
Globals.ThisAddIn.Application.Goto(Me.first_visible_cell_not_fixed, True)
Me.frozen_scenario = False
End If
End Sub

Type mismatch error in VBA when adding data to textbox

I have a TextBox and a ListBox with a list of various cities being populated from an Excel file
Now each city has one of two options: either within territory or outside. I want that option to be shown in textBox
I tried something like this :
Private Sub CommandButton1_Click()
TextBox2.Value = Application.VLookup(Me.ListBox1.Text,Sheets("Sheet1").Range("B:C"), 2, False)
End Sub
But am getting error stating that :
Run Time Error 2147352571 (80020005) . Could not set Value property. Type mismatch.
My excel file is something like this :
Let say your data are stored in Sheet1. You want to bind these data to ListBox1 on UserForm. I'd suggest to use custom function to load data instead of binding data via using RowSource property. In this case i'd suggest to use Dictionary to avoid duplicates.
See:
Private Sub UserForm_Initialize()
Dim d As Dictionary
Dim aKey As Variant
Set d = GetDistinctCitiesAndTerritories
For Each aKey In d.Keys
With Me.ListBox1
.AddItem ""
.Column(0, .ListCount - 1) = aKey
.Column(1, .ListCount - 1) = d.Item(aKey)
End With
Next
End Sub
'needs reference to Microsoft Scripting Runtime!
Function GetDistinctCitiesAndTerritories() As Dictionary
Dim wsh As Worksheet
Dim dict As Dictionary
Dim i As Integer
Set wsh = ThisWorkbook.Worksheets("Sheet1")
Set dict = New Dictionary
i = 2
Do While wsh.Range("A" & i) <> ""
If Not dict.Exists(wsh.Range("B" & i)) Then dict.Add wsh.Range("B" & i), wsh.Range("C" & i)
i = i + 1
Loop
Set GetDistinctCitiesAndTerritories = dict
End Function
After that, when user clicks on ListBox, city and territory are displayed in corresponding textboxes.
Private Sub ListBox1_Click()
Me.TextBoxCity = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
Me.TextBoxTerritory = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End Sub
Note: code was written straight from the head, so it can contains errors!
The problem is likely that you aren't checking to see to see if the call to Application.VLookup succeeded. Most values returned can be successfully cast to a String - with one important exception: If the VLookup returns an error, for example it doesn't find Me.ListBox1.Text - it can't cast the Variant returned directly.
This should demonstrate:
Private Sub ReturnsOfVLookup()
Dim works As Variant, doesnt As String
works = Application.VLookup("Something not found", _
Sheets("Sheet1").Range("B:C"), 2, False)
Debug.Print works
On Error Resume Next
doesnt = Application.VLookup("Something not found", _
Sheets("Sheet1").Range("B:C"), 2, False)
If Err.Number <> 0 Then
Debug.Print Err.Description
Else
Debug.Print doesnt 'We won't be going here... ;-)
End If
End Sub

looping through worksheet command buttons and change visibility

I'm trying to write a code to make a number of buttons visible depending on a cell value
I have 10 command buttons all are invisible and I want to show only the first x
x is the value of cell "A1" in "Sheet1" (will be from 1 to 10)
Command buttons names are default names (CommandButton4, CommandButton5, ... , CommandButton13)
Note: I'm working with a worksheet not a userform
This is my code but i need something shorter and more pro and efficient
Private Sub CommandButton15_Click()
Dim i As Long
Dim CommandButton() As Variant
Application.ScreenUpdating = False
CommandButton = Array("CommandButton4", "CommandButton5", "CommandButton6", "CommandButton7", "CommandButton8", "CommandButton9", "CommandButton10", "CommandButton11", "CommandButton12", "CommandButton13")
For i = LBound(CommandButton) To LBound(CommandButton) + Sheet1.Range("A1").Value - 1
Sheet1.Shapes(CommandButton(i)).Visible = True
Next i
Application.ScreenUpdating = True
End Sub
Need ur help plz
As said in the comment you should rename your buttons. That just makes things easier.
You could for example name them "btn1", "btn2", "btn3" ....
Your code is ok and i can't see major errors. I don't know if you want to add new buttons later.
If so i would recommend something more generic. If you rename the buttons to "btn1"... then you could use something like this:
Private Sub CommandButton15_Click()
Dim btn As OLEObject, name As String, i As Long
i = Sheets(1).Range("A1").Value + 1
For Each btn In ActiveSheet.OLEObjects
name = btn.name
If btn.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
If Int(Right(name, Len(name) - 3)) < i Then
btn.Visible = True
Else
btn.Visible = False
End If
End If
Next
End Sub
So you can add new buttons name them with the "btn.." pattern and you don't have to change your Code.