Copying and Pasting Multiple Combo Boxes

W

wootthepants

New Member
Joined
Apr 30, 2019
Messages
8
Hello!
I was wondering if someone could help me with the following (please keep in mind that I'm a bit new to VBA):

I have a spreadsheet where I want to create one combobox per cell so the user can type in a keyword selection, pick from the drop down, which will return results and auto populate into other fields. I've pretty much figure out how to do most of this but, since my sheet could possibly have several hundred rows, how do you copy the original combo box multiple times, with the LinkedCell reference automatically changing to the next cell (B3 to B4 etc) without having to do this manually one by one?

I found the following code which is supposed to do this exact thing except it seems to just move the original combo box rather than make copies. It also changes the cell reference to be one more than it should (combobox is hovering over B3 but the LinkedCell is B4).

Essentially, I have a combo box hovering over cell B2 and linked to cell B2. I want the code to copy that combo box, past the copy immediately below the original box (hovering over B3), and change the LinkedCell to B3. Then I want this repeated for however many copies I want to make (I've noted 10 for testing purposes here). Oh and a data validation drop down won't work as I need the combo box to auto fill in real time and to display values from more than one column. Thank you!!


Sub AddFormsComboBoxes()
'assumes 1 combo box named 'Drop Down 1' has
'been placed on the sheet and set up with
'the ListFillRange information so all that is
'needed to do is copy that control and
'change the Link cell address
'
'we can control everything needed for the
'process here
'these describe the LinkedCell address
'for the first/source control
Const sourceControlName = "ComboBox1" ' change as required
Const linkCellCol = "B"
Const firstLinkRow = 2 ' row for original control
'control how many copies to make
Const copiesToMake = 10 ' original + 99 = 100
'you can make this a positive number to
'add spacing between the new controls
'as set to 0 the controls will be
'placed very tightly on the sheet
Const vSpaceBetweenControls = 0
'variables needed to perform the copying and positioning
Dim leftPosition As Single
Dim topPosition As Single
Dim ctlHeight As Single
Dim linkCellRow As Long
Dim LC As Long

ActiveSheet.Shapes.Range(Array(sourceControlName)).Select
leftPosition = Selection.Left
topPosition = Selection.Top
ctlHeight = Selection.Height
linkCellRow = firstLinkRow
Application.ScreenUpdating = False ' speeds up process
Selection.Copy
For LC = 1 To copiesToMake
topPosition = topPosition + ctlHeight + vSpaceBetweenControls
linkCellRow = linkCellRow + 1
ActiveSheet.Paste ' new control becomes selected
With Selection
.Top = topPosition
.Left = leftPosition ' aligned vertically
.LinkedCell = linkCellCol & linkCellRow
End With
Next

End Sub
 
Sort by date Sort by votes
DanteAmor said:
I understand, if you want to capture a word and the possible options appear, then it must be with a combobox.
You could upload a file with sample data and I'll prepare an example with a userform.

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
Click to expand...


Here's the link: https://www.dropbox.com/s/ccvze2avg7y1bwy/ComboBoxListExample.xlsm?dl=0

I've made comments on the spreadsheet and included both the faulty combobox I've been trying to use and also a Data Validation version.
Thank you so much for the help!
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
In the events of the sheet put the following code:

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Cancel = True
        UserForm1.Show
    End If
End Sub

SHEET EVENT
Right click the tab "Worksheet" sheet, select view code and paste the code into the window that opens up.

---

Create a userform with this (listbox1, textbox1, 2 commandbutton)

f27dbe8098272eefb334c972be0f7192.jpg


---
Put the following code in the userform:

Code: 
Dim sh2 As Worksheet
Dim cargando As Boolean
Dim elind As Long
'
Private Sub ComboBox1_Change()
    Dim dato1 As String, dato2 As String, dato3 As String, valor As String, datoa As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    If cargando = True Then Exit Sub
    cargando = True
    elind = -1
    dato1 = ComboBox1.Value
    datoa = Replace(dato1, " ", "*")
    dato2 = ""
    If ComboBox1.ListIndex > -1 Then
        dato2 = ComboBox1.List(ComboBox1.ListIndex, 1)
        dato3 = ComboBox1.List(ComboBox1.ListIndex, 2)
    End If
    ComboBox1.Clear
    i = 2
    Do While sh2.Cells(i, "A").Value <> ""
        valor = UCase(sh2.Cells(i, "A").Value & sh2.Cells(i, "B").Value & sh2.Cells(i, "C").Value)
        If valor Like "*" & UCase(datoa) & "*" Then
            ComboBox1.AddItem sh2.Cells(i, "A").Value
            ComboBox1.List(ComboBox1.ListCount - 1, 1) = sh2.Cells(i, "B").Value
            ComboBox1.List(ComboBox1.ListCount - 1, 2) = sh2.Cells(i, "C").Value
        End If
        i = i + 1
    Loop
    If dato2 = "" Then
        ComboBox1.Value = dato1
    Else
        ComboBox1.Clear
        ComboBox1.AddItem dato1
        ComboBox1.List(ComboBox1.ListCount - 1, 1) = dato2
        ComboBox1.List(ComboBox1.ListCount - 1, 2) = dato3
        ComboBox1.ListIndex = 0
        elind = ComboBox1.ListIndex
        ComboBox1 = dato1 & "     " & dato2 & "     " & dato3
    End If
    '
    TextBox1.Visible = True
    TextBox1.SetFocus
    ComboBox1.SetFocus
    ComboBox1.DropDown
    TextBox1.Visible = False
    '
    Application.ScreenUpdating = True
    cargando = False
End Sub


Private Sub CommandButton1_Click()
    Unload Me
End Sub


Private Sub CommandButton2_Click()
    If elind = 0 Then
        ActiveCell.Value = ComboBox1.List(0, 1)
        Unload Me
    Else
        MsgBox "Select description"
        ComboBox1.SetFocus
        ComboBox1.DropDown
    End If
End Sub


'
Private Sub UserForm_Activate()
    Dim i As Long
    
    Set sh2 = Sheets("CustData")
    With ComboBox1
        .MatchEntry = fmMatchEntryNone
        .ColumnCount = 3
        .ColumnWidths = "100; 350; 100"
        i = 2
        Do While sh2.Cells(i, "A").Value <> ""
            .AddItem sh2.Cells(i, "A").Value
            .List(.ListCount - 1, 1) = sh2.Cells(i, "B").Value
            .List(.ListCount - 1, 2) = sh2.Cells(i, "C").Value
            i = i + 1
        Loop
    End With
    TextBox1.Visible = False
End Sub

---
Example:

b8e7d8f635ee3277664e17a807e8278f.jpg



---
It works in the following way:
- Double-click on any cell in column B on the "worksheet" sheet
- The userform opens automatically.
- Start writing in the combobox.
- While you are writing, the elements are automatically listed with some written information.
- Select the desired item from the list and press the OK button.
- The description is put in the cell where you pressed double click.
- If you want to cancel the operation press the cancel button.


Some adjustment may be necessary, but try this version:

https://www.dropbox.com/s/1gdis6foe7nufkl/ComboBoxListExample dam.xlsm?dl=0
 
Upvote 0
DanteAmor said:
In the events of the sheet put the following code:

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Cancel = True
        UserForm1.Show
    End If
End Sub

SHEET EVENT
Right click the tab "Worksheet" sheet, select view code and paste the code into the window that opens up.

---

Create a userform with this (listbox1, textbox1, 2 commandbutton)

f27dbe8098272eefb334c972be0f7192.jpg


---
Put the following code in the userform:

Code: 
Dim sh2 As Worksheet
Dim cargando As Boolean
Dim elind As Long
'
Private Sub ComboBox1_Change()
    Dim dato1 As String, dato2 As String, dato3 As String, valor As String, datoa As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    If cargando = True Then Exit Sub
    cargando = True
    elind = -1
    dato1 = ComboBox1.Value
    datoa = Replace(dato1, " ", "*")
    dato2 = ""
    If ComboBox1.ListIndex > -1 Then
        dato2 = ComboBox1.List(ComboBox1.ListIndex, 1)
        dato3 = ComboBox1.List(ComboBox1.ListIndex, 2)
    End If
    ComboBox1.Clear
    i = 2
    Do While sh2.Cells(i, "A").Value <> ""
        valor = UCase(sh2.Cells(i, "A").Value & sh2.Cells(i, "B").Value & sh2.Cells(i, "C").Value)
        If valor Like "*" & UCase(datoa) & "*" Then
            ComboBox1.AddItem sh2.Cells(i, "A").Value
            ComboBox1.List(ComboBox1.ListCount - 1, 1) = sh2.Cells(i, "B").Value
            ComboBox1.List(ComboBox1.ListCount - 1, 2) = sh2.Cells(i, "C").Value
        End If
        i = i + 1
    Loop
    If dato2 = "" Then
        ComboBox1.Value = dato1
    Else
        ComboBox1.Clear
        ComboBox1.AddItem dato1
        ComboBox1.List(ComboBox1.ListCount - 1, 1) = dato2
        ComboBox1.List(ComboBox1.ListCount - 1, 2) = dato3
        ComboBox1.ListIndex = 0
        elind = ComboBox1.ListIndex
        ComboBox1 = dato1 & "     " & dato2 & "     " & dato3
    End If
    '
    TextBox1.Visible = True
    TextBox1.SetFocus
    ComboBox1.SetFocus
    ComboBox1.DropDown
    TextBox1.Visible = False
    '
    Application.ScreenUpdating = True
    cargando = False
End Sub


Private Sub CommandButton1_Click()
    Unload Me
End Sub


Private Sub CommandButton2_Click()
    If elind = 0 Then
        ActiveCell.Value = ComboBox1.List(0, 1)
        Unload Me
    Else
        MsgBox "Select description"
        ComboBox1.SetFocus
        ComboBox1.DropDown
    End If
End Sub


'
Private Sub UserForm_Activate()
    Dim i As Long
    
    Set sh2 = Sheets("CustData")
    With ComboBox1
        .MatchEntry = fmMatchEntryNone
        .ColumnCount = 3
        .ColumnWidths = "100; 350; 100"
        i = 2
        Do While sh2.Cells(i, "A").Value <> ""
            .AddItem sh2.Cells(i, "A").Value
            .List(.ListCount - 1, 1) = sh2.Cells(i, "B").Value
            .List(.ListCount - 1, 2) = sh2.Cells(i, "C").Value
            i = i + 1
        Loop
    End With
    TextBox1.Visible = False
End Sub

---
Example:

b8e7d8f635ee3277664e17a807e8278f.jpg



---
It works in the following way:
- Double-click on any cell in column B on the "worksheet" sheet
- The userform opens automatically.
- Start writing in the combobox.
- While you are writing, the elements are automatically listed with some written information.
- Select the desired item from the list and press the OK button.
- The description is put in the cell where you pressed double click.
- If you want to cancel the operation press the cancel button.


Some adjustment may be necessary, but try this version:

https://www.dropbox.com/s/1gdis6foe7nufkl/ComboBoxListExample dam.xlsm?dl=0
Click to expand...


You.Are.A.Genius! Thank you so much for explaining this!

If you still have patience for me, I just have one more questions since I'm having trouble finding the answer online: Is there a way to have the other cells in the row on the 'Worksheet' auto-fill from the CustData sheet based on the Userform selection? I know how to do this with VLookup based on the part# but can't seem to figure out what I would need to input here for this to happen.
(I don't go on a lot of forums. Is this something I should start a new thread for?)

Thank you! Thank you! Thank you!
 
Upvote 0
Update this line in the code to put the part number in column A

Code: 
Private Sub CommandButton2_Click()
    If elind = 0 Then
        ActiveCell.Value = ComboBox1.List(0, 1)
[B][COLOR=#0000ff]        ActiveCell.Offset(, -1).Value = ComboBox1.List(0, 0)[/COLOR][/B]
        Unload Me
    Else
        MsgBox "Select description"
        ComboBox1.SetFocus
        ComboBox1.DropDown
    End If
End Sub
 
Upvote 0
DanteAmor said:
Update this line in the code to put the part number in column A

Code: 
Private Sub CommandButton2_Click()
    If elind = 0 Then
        ActiveCell.Value = ComboBox1.List(0, 1)
[B][COLOR=#0000ff]        ActiveCell.Offset(, -1).Value = ComboBox1.List(0, 0)[/COLOR][/B]
        Unload Me
    Else
        MsgBox "Select description"
        ComboBox1.SetFocus
        ComboBox1.DropDown
    End If
End Sub
Click to expand...

It works perfectly! Thank you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
VBA & Combo Box (Form Control) Lock
Replies
3
Views
646
Jaafar Tribak
Jaafar Tribak
E
  • Solved
Problem with searchable combo box
Replies
9
Views
2K
Akuini
Akuini
X
  • Solved
Unlock a cell with a ComboBox entry
Replies
2
Views
894
XrayLemi
X
L
  • Question Question
Copy daily changing rows from a workbook paste to another workbook
Replies
1
Views
621
OaklandJim
O
M
  • Question Question
Need to add _AfterUpdate events to a dynamically-created class
Replies
1
Views
1K
Matrovsky
M

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top