combobox searchable

[ZTK]

Again requesting your help .......

I found a macro for drop-down lists, it works perfect for me as it creates the combobox in any "simple" drop-down list so there is no need to copy it manually.


I would like the combobox to have the search function, to filter the possible texts to use.

I show you the macro I use:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Update by Extendoffice: 2020/05/19

Dim xCombox As OLEObject

Dim xStr As String

Dim xWs As Worksheet

Dim xArr



Set xWs = Application.ActiveSheet

On Error Resume Next

If Target.Validation.Type = 3 Then

Target.Validation.InCellDropdown = False

Cancel = True

xStr = Target.Validation.Formula1

xStr = Right(xStr, Len(xStr) - 1)

If xStr = "" Then Exit Sub

Set xCombox = xWs.OLEObjects("TempCombo")

With xCombox

.ListFillRange = ""

.LinkedCell = ""

.Visible = False

End With

With xCombox

.Visible = False

.Left = Target.Left

.Top = Target.Top

.Width = Target.Width + 3

.Height = Target.Height + 3

.ListFillRange = xStr

If .ListFillRange = "" Then

xArr = Split(xStr, ",")

Me.TempCombo.List = xArr

End If

.LinkedCell = Target.Address

End With

xCombox.Activate

Me.TempCombo.DropDown

End If

End Sub

Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Select Case KeyCode

Case 9

Application.ActiveCell.Offset(0, 1).Activate

Case 13

Application.ActiveCell.Offset(1, 0).Activate

End Select

End Sub




thanks in advance

 

[ZTK]

What was the error message?
See if this helps;

automation error -2146232576 (80131700) on creating an array

I have a macro that's working on one computer just fine, however when I try to run it on another computer I get the following error: Run-time error '-2146232576 (80131700)' Automation error Here'...

stackoverflow.com

Sorry for the delay for the answer.

Do not verify the error as such, it only pointed out the previous text

I'll try again to take note


Additionally, regarding the solution you shared, it would not be possible for me to install the .NET 3.5 library since my work computers have a lock.

I will update the error to see if there is another solution

Thanks again for your time

 

[ZTK]

ALREADY VERIFY ...

AFTER SOME UPDATES OF WINDOWS "MAGICALLY" NO LONGER THROWS AN ERROR AND I COULD VERIFY THAT IT WORKS ENOUGH WELL.

I ONLY HAVE A COUPLE OF DETAILS ...

WHEN ADDING MORE ROWS BETWEEN ANY HEADER WILL THERE BE A WAY THAT THE COMBOBOX ARE ALSO ADDED AUTOMATICALLY? WITHOUT HAVING TO MODIFY THE RANGE IN THE MACRO

AND CAN THE ON / OFF BUTTON BE DELETED AND LEAVE THE MACRO ENABLED AT ALL TIMES?

THANK YOU AGAIN

 

[DanteAmor]

Hi ZTK:

It is a long explanation. I'm going to divide it into points.

1. Run the following code to set the properties of the TempCombo and the sheet.

Sub properties_Combo()
  With Sheets("BITA").TempCombo
    .Visible = False
    .MatchEntry = 2
    .ListFillRange = ""
  End With
  Application.EnableEvents = True
End Sub

2. You can use merged or single cells.

3. In the following examples, in merged cells Z53 to AE53 is the validation for the "N_ubicacion".
In simple cell AF53 there is the validation "N_Puesto".
You can also try cells AK53 to AQ53 for N_Justificacion validation

4. In the sheet "BD" for each data list you must create a range name, for example, for the list "Ubicación", I created the range name "N_ubicacion" includes the cells Table11[UBICACIÓN], but since you have the data In a table, when you add new data, automatically the list of the range name "N_ubicacion" will be updated.

5. In cell Z53 you create the data validation and in the Source write N_Ubicacion

6. So, put the following code in the sheet events.

Option Explicit

Dim cargando As Boolean
'
Private Sub TempCombo_Change()
  DoEvents
  If cargando = True Then Exit Sub
  cargando = True
  Call CargaCombo
  cargando = False
End Sub

Sub CargaCombo()
  Dim dato As Variant
  Dim cell As Range, rng As Range, c As Range
 
  With Me.TempCombo
    dato = .Value
    Set cell = Range(.LinkedCell)
    Set rng = Sheets("BD").Range(Mid(cell.Validation.Formula1, 2))
    .Clear
    For Each c In rng
      If UCase(c.Value) Like "*" & UCase(dato) & "*" Then .AddItem c.Value
    Next
    .Value = dato
    cell.Activate
    .Activate
    .DropDown
    cell.Value = .Value
  End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim xWs As Worksheet
  Dim xStr As String
  Dim rng As Range, c As Range, xTarget As Range
 
  Set xWs = Application.ActiveSheet
 
  On Error Resume Next
  Me.TempCombo.Visible = False
  DoEvents
  Application.EnableEvents = False
  If ActiveCell.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
  End If
  On Error GoTo 0
  Application.EnableEvents = True
 
  If Target.CountLarge > 20 Then Exit Sub
  
  Set xTarget = Target.Cells(1, 1)
 
  If xTarget.Validation.Type <> 3 Then Exit Sub
  xStr = Mid(xTarget.Validation.Formula1, 2)
  If xStr = "" Then Exit Sub
  xTarget.Validation.InCellDropdown = False
 
  If cargando = True Then Exit Sub
  cargando = True
  With Me.TempCombo
    .LinkedCell = xTarget.Address
    .Left = Target.Left
    .Top = Target.Top
    .Width = Target.Width + 3
    .Height = Target.Height + 3
    .Value = xTarget.Value
  End With
  Call CargaCombo
  cargando = False
End Sub

Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Select Case KeyCode
    Case 9: ActiveCell.Offset(0, 1).Activate
    Case 13: ActiveCell.Offset(1, 0).Activate
    Case 27: Me.TempCombo.Visible = False
  End Select
End Sub

7. How does it work. You can select any cell that has a validation and it will automatically put the combobox with the list of the corresponding validation. You can write any word and automatically the list will be filtered.

8. I share the file with you with everything. I hope it is what you are looking for or helps you to get it.

BITX Dante Amor.xlsm

drive.google.com

 

[ZTK]

Hi ZTK:

It is a long explanation. I'm going to divide it into points.

1. Run the following code to set the properties of the TempCombo and the sheet.

Sub properties_Combo()
  With Sheets("BITA").TempCombo
    .Visible = False
    .MatchEntry = 2
    .ListFillRange = ""
  End With
  Application.EnableEvents = True
End Sub

2. You can use merged or single cells.

3. In the following examples, in merged cells Z53 to AE53 is the validation for the "N_ubicacion".
In simple cell AF53 there is the validation "N_Puesto".
You can also try cells AK53 to AQ53 for N_Justificacion validation

View attachment 47265

4. In the sheet "BD" for each data list you must create a range name, for example, for the list "Ubicación", I created the range name "N_ubicacion" includes the cells Table11[UBICACIÓN], but since you have the data In a table, when you add new data, automatically the list of the range name "N_ubicacion" will be updated.

View attachment 47266

5. In cell Z53 you create the data validation and in the Source write N_Ubicacion

View attachment 47268


6. So, put the following code in the sheet events.

Option Explicit

Dim cargando As Boolean
'
Private Sub TempCombo_Change()
  DoEvents
  If cargando = True Then Exit Sub
  cargando = True
  Call CargaCombo
  cargando = False
End Sub

Sub CargaCombo()
  Dim dato As Variant
  Dim cell As Range, rng As Range, c As Range
 
  With Me.TempCombo
    dato = .Value
    Set cell = Range(.LinkedCell)
    Set rng = Sheets("BD").Range(Mid(cell.Validation.Formula1, 2))
    .Clear
    For Each c In rng
      If UCase(c.Value) Like "*" & UCase(dato) & "*" Then .AddItem c.Value
    Next
    .Value = dato
    cell.Activate
    .Activate
    .DropDown
    cell.Value = .Value
  End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim xWs As Worksheet
  Dim xStr As String
  Dim rng As Range, c As Range, xTarget As Range
 
  Set xWs = Application.ActiveSheet
 
  On Error Resume Next
  Me.TempCombo.Visible = False
  DoEvents
  Application.EnableEvents = False
  If ActiveCell.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
  End If
  On Error GoTo 0
  Application.EnableEvents = True
 
  If Target.CountLarge > 20 Then Exit Sub
 
  Set xTarget = Target.Cells(1, 1)
 
  If xTarget.Validation.Type <> 3 Then Exit Sub
  xStr = Mid(xTarget.Validation.Formula1, 2)
  If xStr = "" Then Exit Sub
  xTarget.Validation.InCellDropdown = False
 
  If cargando = True Then Exit Sub
  cargando = True
  With Me.TempCombo
    .LinkedCell = xTarget.Address
    .Left = Target.Left
    .Top = Target.Top
    .Width = Target.Width + 3
    .Height = Target.Height + 3
    .Value = xTarget.Value
  End With
  Call CargaCombo
  cargando = False
End Sub

Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Select Case KeyCode
    Case 9: ActiveCell.Offset(0, 1).Activate
    Case 13: ActiveCell.Offset(1, 0).Activate
    Case 27: Me.TempCombo.Visible = False
  End Select
End Sub

7. How does it work. You can select any cell that has a validation and it will automatically put the combobox with the list of the corresponding validation. You can write any word and automatically the list will be filtered.

8. I share the file with you with everything. I hope it is what you are looking for or helps you to get it.

BITX Dante Amor.xlsm

drive.google.com

Sorry, I hadn't had a chance to check the file

IT WORKS EXCELLENT, JUST WHAT I NEEDED !!!!!

I will change the data and attend to your recommendations to simplify everything, I hope I do not give more hassles

I hope to have everything ready in the next few days to be able to close the topic in definitive


thanks a lot

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[ZTK]

I'm glad to help you. Thanks for the feedback.

Again giving annoyances ....

I am moving forward with the final optimization of the file and I realize that the "undo" function (Ctrl + Z) was disabled outside the macro, I mean that if I write in any cell that is not a validated list I cannot undo the action performed ...

Is there a way to fix that detail?

For the rest, as I said, it's going great

 

[DanteAmor]

In the file that I sent you, if I write in any cell, which does not have a validation list, i press enter and then press control Z, it works.
Do you have other macros running?

 

[ZTK]

In the file that I sent you, if I write in any cell, which does not have a validation list, i press enter and then press control Z, it works.
Do you have other macros running?

That's right, I have 2 more that are activated by button

One to email the active sheet and one to open external files


But if you tell me it works, I'll check it out at night

I possibly did something wrong

 

[ZTK]

That's right, I have 2 more that are activated by button

One to email the active sheet and one to open external files


But if you tell me it works, I'll check it out at night

I possibly did something wrong

Hello again.

I already verified and in effect the undo function is disabled.

To be sure I deleted all other macros and the problem continues ...

Could you support me with that?

Excuse me again

 

[DanteAmor]

You can share your book on google drive.
And explain step by step what you do so that I can reproduce the problem you have.