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
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

mIsT3r_x

New Member
Joined
Oct 14, 2019
Messages
8
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]
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,012
Office Version
  1. 2010
Platform
  1. Windows
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 ?
 

mIsT3r_x

New Member
Joined
Oct 14, 2019
Messages
8
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.
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,012
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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
 

mIsT3r_x

New Member
Joined
Oct 14, 2019
Messages
8
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
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,012
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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.
 

mIsT3r_x

New Member
Joined
Oct 14, 2019
Messages
8
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
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,012
Office Version
  1. 2010
Platform
  1. Windows
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.
 

mIsT3r_x

New Member
Joined
Oct 14, 2019
Messages
8
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,655
Messages
5,549,259
Members
410,905
Latest member
Extjel
Top