Dynamic linking of ActiveX text box to table VBA

sabin348

New Member
Joined
Nov 2, 2013
Messages
9
I've been busting my head on this for two days. I have an ActiveX text box and a data table. When I enter data into the text box I want it to edit the data in the table. However, I want the cell linking to be dynamic based on the customer selected in the dropdown box in $G$2. If I have Customer 1 selected, it should edit $I6, and if Customer 2, then cell $I7. Likewise, when I change the customer in the drop down, the text box data should change to match. I figure I need some sort of match formula built into the range portion of the VBA, but I just can't seem to make anything work.

Here is the code I'm starting with, although it doesn't get me very far. Thx,

VBA Code:
Private Sub TextBox1_Change()

ActiveSheet.Range("A1") = ActiveSheet.TextBox1.Value

End Sub
 

Attachments

  • Example.PNG
    Example.PNG
    14.4 KB · Views: 10

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,327
With a table (a VBA ListObject) it's better to refer to cells by their table row number and column name, rather than cell addresses ($I6, $I7), so that if you move the table the code will still work.

For your request, you need the TextBox1_Change event handler to put the text box value in the correct cell in the table. You also need a Worksheet_Change event handler to go the other way: put the correct cell in the table in TextBox1.

In VBA you can refer to a table (ListObject) by its index number or by its name. In the code below I have shown both ways, assuming the table is the first (index 1) table on the sheet or its name is "CustomersTable".
VBA Code:
Private Sub TextBox1_Change()

    Dim table As ListObject
    Dim customerRow As Variant
    
    'Either: refer to table by its index number
    Set table = Me.ListObjects(1)
    
    'Or: refer to table by its name
    'Set table = Me.ListObjects("CustomersTable")
    
    customerRow = Application.Match(Range("G2").Value, table.ListColumns("ID").DataBodyRange, 0)
    
    If Not IsError(customerRow) Then
        table.ListColumns("TextBox1 Notes").DataBodyRange(customerRow).Value = Me.TextBox1.Text
    Else
        MsgBox "Customer '" & Range("G2").Value & "' not found in table '" & table.Name & "' column 'ID'", vbExclamation
    End If
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim table As ListObject
    Dim customerRow As Variant
    
    If Target.Address = Range("G2").Address Then
    
        'Either: refer to table by its index number
        Set table = Me.ListObjects(1)
        
        'Or: refer to table by its name
        'Set table = Me.ListObjects("CustomersTable")
        
        customerRow = Application.Match(Target.Value, table.ListColumns("ID").DataBodyRange, 0)
        
        If Not IsError(customerRow) Then
            Me.TextBox1.Text = table.ListColumns("TextBox1 Notes").DataBodyRange(customerRow).Value
        Else
            MsgBox "Customer '" & Target.Value & "' not found in table '" & table.Name & "' column 'ID'", vbExclamation
        End If
    
    End If
    
End Sub
 

sabin348

New Member
Joined
Nov 2, 2013
Messages
9
This works really well John. Thank you!
Ultimately, I'd like to have multiple text boxes on a single sheet feeding data into different columns within the table that would be housed on a separate sheet in the workbook. How could I make it more adaptable? I can edit and duplicate the text box change code for more boxes, but I'm hung up on the worksheet change.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
7,327
Here is the code modified for multiple text boxes on one sheet and a table on a separate sheet.

The Customer ID dropdown is cell G2 on the sheet containing the text boxes.

The 4 ActiveX text boxes are named and correspond to the table column names as follows:

TextBox1 - Column2
TextBox2 - Notes (not TextBox1 Notes)
TextBox3 - Column4
TextBox4 - Column5

The table is on a sheet named "Table". This sheet name is referenced in the line Set table = Worksheets("Table").ListObjects(1) which occurs in 2 places in the code. (The table is named "CustomersTable2", but this name isn't used because the code uses the table's index number.)

Put all this code in the sheet module of the sheet containing the ActiveX text boxes.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = Range("G2").Address Then
        Update_TextBoxes Range("G2").Value
    End If
End Sub


Private Sub TextBox1_Change()
    Update_Table_Column Me.TextBox1.Text, "Column2"
End Sub

Private Sub TextBox2_Change()
    Update_Table_Column Me.TextBox2.Text, "Notes"
End Sub

Private Sub TextBox3_Change()
    Update_Table_Column Me.TextBox3.Text, "Column4"
End Sub

Private Sub TextBox4_Change()
    Update_Table_Column Me.TextBox4.Text, "Column5"
End Sub


Private Sub Update_Table_Column(textBoxValue As String, tableColumnName As String)

    Dim table As ListObject
    Dim customerRow As Variant
  
    'Either: refer to table on the "Table" sheet by its index number
    Set table = Worksheets("Table").ListObjects(1)
  
    'Or: refer to table on the "Table" sheet by its name
    'Set table = Worksheets("Table").ListObjects("CustomersTable2")
  
    customerRow = Application.Match(Range("G2").Value, table.ListColumns("ID").DataBodyRange, 0)
  
    If Not IsError(customerRow) Then
        table.ListColumns(tableColumnName).DataBodyRange(customerRow).Value = textBoxValue
    Else
        MsgBox "Customer '" & Range("G2").Value & "' not found in table '" & table.Name & "' column 'ID'", vbExclamation
    End If

End Sub


Public Sub Update_TextBoxes(CustomerID As String)

    Dim table As ListObject
    Dim customerRow As Variant
  
    'Either: refer to table on the "Table" sheet by its index number
    Set table = Worksheets("Table").ListObjects(1)
  
    'Or: refer to table on the "Table" sheet by its name
    'Set table = Worksheets("Table").ListObjects("CustomersTable2")
  
    customerRow = Application.Match(CustomerID, table.ListColumns("ID").DataBodyRange, 0)
  
    If Not IsError(customerRow) Then
        'Customrer ID found, so populate each text box with the appropriate table column value
        Me.TextBox1.Text = table.ListColumns("Column2").DataBodyRange(customerRow).Value
        Me.TextBox2.Text = table.ListColumns("Notes").DataBodyRange(customerRow).Value
        Me.TextBox3.Text = table.ListColumns("Column4").DataBodyRange(customerRow).Value
        Me.TextBox4.Text = table.ListColumns("Column5").DataBodyRange(customerRow).Value
    Else
        MsgBox "Customer '" & CustomerID & "' not found in table '" & table.Name & "' column 'ID'", vbExclamation
    End If

End Sub
 
Solution
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,845
Messages
5,833,936
Members
430,247
Latest member
w9u5280o

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
Top