Update cell with a value when form field is select

2019-08-16 15:55发布

I have an excel workbook with modeless form. The way it's setup is that: each sheet in the workbook has a tab in the form. Each field in these tabs is Linked to a cell in corresponding sheet. So when a value is changed/updated in the form, it is automatically updated in the relevant cell. The way I am doing this is by using the onChange event for each filed which call's a UDF that does the updating. My question, there are a lot of fields in the form and lots more to be added. Is there a way to update relevant cell when a field in the form is selected without having to add the call to a UDF in onChange event for each field?

I have tried using things like ControlSource but that only one way where it just updates the value in the form but doesn't update the value in the cell when form is updated.

As a side note, unfortunately I cannot share the form or the sheet but am willing to answer any questions

EDIT

Below is the function that updates the field:

Sub UpdateWorksheetValue(ByVal oObj As Object)
    Dim oWS As Worksheet
    Dim sCurrentValue As String
    Dim iC As Long

    ' Lets check if tag is set
    If Len(Trim(oObj.Tag)) = 0 Then
        MsgBox "Empty tag found for '" & oObj.Name & "' field. Failed to update field value" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
        Exit Sub
    ElseIf Len(Trim(Mid(oObj.Tag, InStr(1, oObj.Tag, "¬") + 1))) = 0 Then
        MsgBox "Tag for '" & oObj.Name & "' field does not include page title. Failed to update field value" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
        Exit Sub
    End If

    ' Set worksheet
    Select Case LCase(Trim(Mid(oObj.Tag, InStr(1, oObj.Tag, "¬") + 1)))
        Case "client identification"
            Set oWS = oWB.Worksheets("Client Identification - Output")
        Case "request details"
            Set oWS = oWB.Worksheets("Request Details - Output")
        Case "db responsible individuals"
            Set oWS = oWB.Worksheets("DB Responsible Ind  - Output")
        Case "additional details"
            Set oWS = oWB.Worksheets("Additional Details - Output")

    End Select

    ' Set value
    With oWS

        ' Lets check if tag is set
        If Len(Trim(Mid(oObj.Tag, 1, InStr(1, oObj.Tag, "¬") - 1))) = 0 Then
            MsgBox "Tag for '" & oObj.Name & "' field does not include corresponding cell information. Failed to update field value in '" & oWS.Name & "' worksheet" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
            Exit Sub
        End If

        ' Set the search value
        .Range("Z1").Value = Mid(oObj.Tag, 1, InStr(1, oObj.Tag, "¬") - 1)
        DoEvents

        ' If a row with tag text is not found, throw a message and exit sub
        If Len(Trim(.Range("Z2").Value)) = 0 Then
            MsgBox "Unable to find corresponding cell for '" & oObj.Name & "' field in '" & .Name & "' worksheet. Failed to update field value" & vbCrLf & vbCrLf & "Please ensure that the field's 'Tag' matches a cell in the sheet or contact system administrator", vbCritical + vbOKOnly, "Update Failed"
            Exit Sub
        End If

        ' Set field value
        Select Case LCase(TypeName(oObj))
            Case "textbox", "combobox"
                .Range("B" & .Range("Z2").Value).Value = oObj.Value
            Case "optionbutton"
                If oObj.Value = True Then
                    .Range("B" & .Range("Z2").Value).Value = oObj.Caption
                Else
                    .Range("B" & .Range("Z2").Value).Value = ""
                End If
            Case "listbox"

                ' First lets the current cell value
                sCurrentValue = .Range("B" & .Range("Z2").Value).Value

                ' Now lets build the string for the cell
                For iC = 0 To oObj.ListCount - 1
                    If oObj.Selected(iC) And InStr(1, sCurrentValue, oObj.List(iC)) = 0 Then
                        sCurrentValue = sCurrentValue & "/" & oObj.List(iC)
                    ElseIf Not oObj.Selected(iC) And InStr(1, sCurrentValue, oObj.List(iC)) > 0 Then
                        sCurrentValue = Replace(sCurrentValue, "/" & oObj.List(iC), "")
                    End If
                Next

                ' And finally, set the value
                .Range("B" & .Range("Z2").Value).Value = sCurrentValue

        End Select

    End With

    ' Clear object
    Set oWS = Nothing

End Sub

EDIT 2
I now have a class called formEventClass as suggested by David. Contents of the class are:

Option Explicit

Public WithEvents tb As MSForms.TextBox
Private Sub tb_Change()
    UpdateWorksheetValue (tb)
End Sub

But when I make a change in any given text box, cells are not updated (as per David's suggestion, I've removed the call to UpdateWorksheetValue in text box onChange event. Cells are not updated even when I tab out of the field. As this is working for David, I suspect I am missing something here

1条回答
Fickle 薄情
2楼-- · 2019-08-16 16:47

If you want to get fancy using WithEvents...

Create a Class Module and name it tbEventClass. Put the following code in this module.

Option Explicit

Public WithEvents tb As MSForms.TextBox
Private Sub tb_Change()
    Call UpdateWorksheetValue(tb)
End Sub

This defines a custom class (tbEventClass) which is responsive to the events of it's tb property which is a TextBox. You'll need to map your textboxes to instances of this class during the form's Initialize event:

Public textbox_handler As New Collection
Private Sub UserForm_Initialize()
Dim ctrl As Control, tbEvent As tbEventClass
For Each ctrl In Me.Controls
    If TypeName(ctrl) = "TextBox" Then
        Set tbEvent = New tbEventClass
        Set tbEvent.tb = ctrl
        textbox_handler.Add tb
    End If
Next

End Sub

Important: You will either need to remove or modify the Change event handlers in the UserForm module to avoid duplicate calls to the "update" procedure. If the only thing going on in those event handlers is the call to your update macro, just get remove the event handlers entirely, they're fully represented by the tbClass. If those events contain other code that does other stuff, just remove or comment out the line(s) that call on your update function.

Update:

This is working for me with the controls within a MultiPage and required ZERO changes to the implemented code above.

enter image description here

查看更多
登录 后发表回答