Dynamic linking of ActiveX text box to table VBA

[sabin348]

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,

Private Sub TextBox1_Change()

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

End Sub

 

[John_w]

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".

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]

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]

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.

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

 

[sabin348]

Okay, That's freaking awesome! Thank you so much for the help!