Can I make my VBA trigger automatically off a cell updated from a DDE link?

mIsT3r_x

New Member
Joined
Oct 14, 2019
Messages
8
Here's what I'm trying to do - use Excel's DDE capabilities to communicate with a Rockwell PLC.

For a proof of concept, I'm setting a boolean tag in the PLC, which is read as 1 or 0 via the DDE link in Excel, and I would like that to populate a list of 10 random numbers between 1 and 4. I'm just using 10 cells with the RAND func which recalculates on the boolean tag. The problem I'm having is trying to get those 10 values written back to the PLC automatically. I can do it manually with an ActiveX Button, but can't find a way to automate this function off the trigger tag.

I've read a lot of stuff, and some doesn't even make sense anymore. I'm having a hard time getting the parts stitched together. I read an old thread here from 2000 that I thought would work but doesn't. Here's the code I have so far with a lot of commented code for things I tried and didn't work.

Code:
Private Function OpenRSLinx()
    On Error Resume Next
    
    'Open the connection to RSLinx
    OpenRSLinx = DDEInitiate("RSLINX", "EXCEL_TEST")
    
    'Check if the connection was made
    If Err.Number <> 0 Then
        MsgBox "Error Connecting to topic", vbExclamation, "Error"
        OpenRSLinx = 0 'Return false if there was an error
    End If
    
End Function


''''''''''''Private Sub Worksheet_Change(ByVal Target As Range)
''''''''''''If Target.Cells.Count > 1 Then Exit Sub
''''''''''''If Target.Cells.Address = "$B$1" Then "use a macro here"
''''''''''''End Sub


'Private Sub Worksheet_Change(ByVal Target As Range)
  '  Dim KeyCells As Range


' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
  '  Set KeyCells = Range("A1:A1")


'If Not Application.Intersect(KeyCells, Range(Target.Address)) _
      '     Is Nothing Then


' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
       ' rslinx = OpenRSLinx() 'Open connection to RSlinx


    'Loop through the cells and write values to the CLX array tags
    'For i = 0 To 9
        'Now the array of DINTs
        'Get the value from the DDE link
        'dintdata = DDERequest(rslinx, "DINT_Array[" & i & "],L1,C1")
        'If there is an error, display a message box
        'If TypeName(dintdata) = "Error" Then
            'If MsgBox("Error reading tag DINT_Array[" & i & "]. " & _
               ' "Continue with write?", vbYesNo + vbExclamation, _
               ' "Error") = vbNo Then Exit For
       ' Else
            'No error, place data in CLX
           ' DDEPoke rslinx, "DINT_Array[" & i & "]", Cells(2 + i, 5)
       ' End If
   ' Next i
    
    'Terminate the DDE connection
   ' DDETerminate rslinx


'End If
'End Sub
Private Sub CommandButton1_Click()


            rslinx = OpenRSLinx() 'Open connection to RSlinx
        
         'Loop through the cells and write values to the CLX array tags
    For i = 0 To 9
   
        'Now the array of DINTs
        'Get the value from the DDE link
        'dintdata = DDERequest(rslinx, "DINT_Array[" & i & "],L1,C1")
        'If there is an error, display a message box
        If TypeName(dintdata) = "Error" Then
            If MsgBox("Error reading tag DINT_Array[" & i & "]. " & _
                "Continue with write?", vbYesNo + vbExclamation, _
                "Error") = vbNo Then Exit For
        Else
            'No error, place data in CLX
            DDEPoke rslinx, "DINT_Array[" & i & "]", Cells(1 + i, 5)
        End If
    Next i
    
    'Terminate the DDE connection
    DDETerminate rslinx


End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Code:
[COLOR=#000000][FONT=Courier]Sub UpdateDDE()[/FONT][/COLOR]
[COLOR=#000000][FONT=Courier]ActiveWorkbook.SetLinkOnData _[/FONT][/COLOR]
[COLOR=#000000][FONT=Courier]    "RSLINX|EXCEL_TEST!'Trigger_to_Excel,L1,C1'", _[/FONT][/COLOR]
[COLOR=#000000][FONT=Courier]    "RMG"[/FONT][/COLOR]
[COLOR=#000000][FONT=Courier]End Sub[/FONT][/COLOR]
 
Upvote 0
For a proof of concept, I'm setting a boolean tag in the PLC, which is read as 1 or 0 via the DDE link in Excel,
what cell are you using for this ?
it has a formula in it, right ?
when do you want it to trigger, 0 to 1, or 1 to 0, or both ?
 
Upvote 0
what cell are you using for this ?
it has a formula in it, right ?
when do you want it to trigger, 0 to 1, or 1 to 0, or both ?

It works now, with most of the above code cut out, and that last snippet of code inserted to trigger my Macro with the data transfer code.

Using RSLINX|EXCEL_TEST!'Trigger_to_Excel,L1,C1' in A1, but I think it could be anywhere, doesn't seem linked by cell location.

It's been triggering on a transition, but it might be useful to use a positive or negative trigger only also.
 
Upvote 0
Not sure I understand any of your answers, but anyway assuming A1 is the cell to monitor for change, try this.
Copy A1 and paste it as values to a cell somewhere out of the way, say Z1.
Right click the sheet tab and select View Code, paste this in
Code:
Private Sub Worksheet_Calculate()
'compare A1 and Z1 to see if A1 changed
If [a1] = [z1] Then Exit Sub    'no change

' A1 changed
If [a1] <> [z1] And [a1] = 1 Then   'A1 changed to 1

''' YOUR STUFF HERE  '''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' what CommandButton1_Click has ????
    
    rslinx = OpenRSLinx() 'Open connection to RSlinx
        
    'Loop through the cells and write values to the CLX array tags
    For i = 0 To 9
   
        'Now the array of DINTs
        'Get the value from the DDE link
        'dintdata = DDERequest(rslinx, "DINT_Array[" & i & "],L1,C1")
        'If there is an error, display a message box
        If TypeName(dintdata) = "Error" Then
            If MsgBox("Error reading tag DINT_Array[" & i & "]. " & _
                "Continue with write?", vbYesNo + vbExclamation, _
                "Error") = vbNo Then Exit For
        Else
            'No error, place data in CLX
            DDEPoke rslinx, "DINT_Array[" & i & "]", Cells(1 + i, 5)
        End If
    Next i
    
    'Terminate the DDE connection
    DDETerminate rslinx

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' re-write Z1 for future monitoring
    Application.EnableEvents = False
    Range("Z1").Value = Range("A1").Value
    Application.EnableEvents = True
    
End If

End Sub
 
Upvote 0
Thx for that, I will try that too, I'm pretty green with VBA.

This was my code that finally worked:
Code:
Sub UpdateDDE()ActiveWorkbook.SetLinkOnData _
    "RSLINX|EXCEL_TEST!'Trigger_to_Excel,L1,C1'", _
    "RMG"
End Sub


Public Function OpenRSLinx()
    On Error Resume Next
    
    'Open the connection to RSLinx
    OpenRSLinx = DDEInitiate("RSLINX", "EXCEL_TEST")
    
    'Check if the connection was made
    If Err.Number <> 0 Then
        MsgBox "Error Connecting to topic", vbExclamation, "Error"
        OpenRSLinx = 0 'Return false if there was an error
    End If
    
End Function


Private Sub Start_Game_Click()


rslinx = OpenRSLinx()
DDEPoke rslinx, "Start_Game", Cells(3, 1)


End Sub


Private Sub Stop_Game_Click()


rslinx = OpenRSLinx()
DDEPoke rslinx, "Start_Game", Cells(4, 1)


End Sub


Private Sub ToggleButton1_Click()
With ToggleButton1
If .Value Then
.ForeColor = RGB(0, 0, 0)
.BackColor = RGB(0, 255, 0)
.Caption = "Running"
rslinx = OpenRSLinx()
DDEPoke rslinx, "Start_Game", Cells(3, 1)


Else
.ForeColor = RGB(0, 0, 0)
.BackColor = RGB(255, 0, 0)
.Caption = "Not Running"
rslinx = OpenRSLinx()
DDEPoke rslinx, "Start_Game", Cells(4, 1)


End If
End With
End Sub
Macro:
Code:
Public Function OpenRSLinx()    On Error Resume Next
    
    'Open the connection to RSLinx
    OpenRSLinx = DDEInitiate("RSLINX", "EXCEL_TEST")
    
    'Check if the connection was made
    If Err.Number <> 0 Then
        MsgBox "Error Connecting to topic", vbExclamation, "Error"
        OpenRSLinx = 0 'Return false if there was an error
    End If
    
End Function
Sub RMG()
 rslinx = OpenRSLinx() 'Open connection to RSlinx
        
         'Loop through the cells and write values to the CLX array tags
    For i = 0 To 9
   
        'Now the array of DINTs
        'Get the value from the DDE link
        'dintdata = DDERequest(rslinx, "DINT_Array[" & i & "],L1,C1")
        'If there is an error, display a message box
        If TypeName(dintdata) = "Error" Then
            If MsgBox("Error reading tag DINT_Array[" & i & "]. " & _
                "Continue with write?", vbYesNo + vbExclamation, _
                "Error") = vbNo Then Exit For
        Else
            'No error, place data in CLX
            DDEPoke rslinx, "DINT_Array[" & i & "]", Cells(1 + i, 5)
        End If
    Next i
    
    'Terminate the DDE connection
    DDETerminate rslinx


End Sub
 
Upvote 0
Don't know RSLinx so don't know what you've got there that triggers automatically but hey, if you're happy, I'm happy.
 
Upvote 0
RSLinx is just Allen Bradley's communication software. It allows a PLC (and other devices) to communicate with the outside world via OPC/DDE. I do have some other questions regarding my code. I had to duplicate this section in my macro (RMG) because it would not compile without it, obviously not finding the Function OpenRSLinx(). Is there a way to rewrite this code to eliminate duplication of this?

Public Function OpenRSLinx() On Error Resume Next

'Open the connection to RSLinx
OpenRSLinx = DDEInitiate("RSLINX", "EXCEL_TEST")

'Check if the connection was made
If Err.Number <> 0 Then
MsgBox "Error Connecting to topic", vbExclamation, "Error"
OpenRSLinx = 0 'Return false if there was an error
End If

End Function
 
Upvote 0
obviously not finding the Function OpenRSLinx()
Could be that your original post has Private Function OpenRSLinx() so will only be availabe to procedures in the same module,
where as a Public Function OpenRSLinx() will be available to all procedures no matter which module they're in.
 
Upvote 0
Yeah, that's what I thought too, but when I change the macro and remove the OpenRSLinx() function, it throws out compile error:Sub or Function not defined.
 
Upvote 0

Forum statistics

Threads
1,223,970
Messages
6,175,718
Members
452,667
Latest member
vanessavalentino83

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