Emit new cell values to the OPC DataHub. Whenever a user enters a new value, this macro checks to see if that cell is named. If so, the macro emits the new value to a OPC DataHub point of the same name. The subroutine name "Worksheet_Change" is special - it is called by Excel whenever a change occurs on the Worksheet due to user input or recalculation (though not a change due to a DDE message; for that see Other Useful Macros).

---------------------------------------------------
Sub Worksheet_Change(ByVal Target As Range)
    Dim rname As String
    Dim channel As Variant
    
    On Error Resume Next
    rname = Target.name.name
    If Not rname = "" Then
        channel = DDEInitiate("datahub", "default")
        DDEPoke channel, rname, Target
        DDETerminate (channel)
    End If
End Sub
---------------------------------------------------

Transmit changes to a range. This pair of macros determines that a cell within a particular named range has changed through user input, and transmits the contents of the range to the OPC DataHub. This is useful because you do not have to configure each cell you want to write out to the DataHub. If the cell that is changed lies within a defined range, then all values in that range are automatically written out to the DataHub.

The Worksheet_Change routine determines the enclosing range for the change, and if the range matches one of a predefined set, it will send that range to the OPC DataHub. The NameOfParentRange function determines the name of the cell range that intersects a given range. If more than one named range in the worksheet intersects the given range, it returns only the first one.

Add to Workbook Macro Code:

---------------------------------------------------
Function NameOfParentRange(Rng As Range) As String
    Dim Nm As Name
    For Each Nm In ThisWorkbook.Names
        If Rng.Parent.Name = Nm.RefersToRange.Parent.Name Then
            If Not Application.Intersect(Rng, Nm.RefersToRange) Is Nothing Then
                NameOfParentRange = Nm.Name
                Exit Function
            End If
        End If
    Next Nm
    NameOfParentRange = ""
End Function
---------------------------------------------------

Add to Sheet1 macro code:

---------------------------------------------------
Sub Worksheet_Change(ByVal r As Range)
    Dim pname As String
    Dim chan As Integer

    pname = ThisWorkbook.NameOfParentRange(r)
    If Not pname = "" Then
        On Error Resume Next
        chan = DDEInitiate("datahub", "default")
        DDEPoke chan, pname, Worksheets("Sheet1").Range(pname)
        DDETerminate (chan)
    End If
End Sub
---------------------------------------------------