VBA - SelectionChange event in Add-in

[D4rwin]

I'm trying to create a "cell tracker" whereby a user is able to select a secondary cell to follow along the movements of the activecell in order to find corresponding data points in two side-by-side tables. I have been able to do this very simply on a single workbook and sheet by adding a button which prompts the user for which cell he would like to "track" and then selecting the union and following the activecell with the SelectionChange event.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If myTog = False Then Exit Sub
    Union(ActiveCell, ActiveCell.Offset(Track_Y, Track_X)).Select
    
End Sub

However, my ultimate goal is to include this functionality in an add-in. Therefore, I am wondering if there is a way to achieve a similar result without the ability to manipulate each individual worksheet. I hope my question was clear enough.

Thanks

 

[Jerry Sullivan]

Hi D4win,

Paste this code into the ThisWorkbook module of your Add-In...

Private WithEvents mApp As Application

Private Sub mApp_SheetSelectionChange(ByVal Sh As Object, _
   ByVal Target As Range)
    
    If gbMyTog = False Then Exit Sub
    On Error GoTo ExitProc
    mApp.EnableEvents = False
    Union(Target, Target.Offset(glTrack_X, glTrack_Y)).Select
ExitProc:
   mApp.EnableEvents = True
End Sub

Private Sub Workbook_Open()
   Set mApp = Application
End Sub

Define global variables in a Standard Code Module of your Add-In

Public gbMyTog As Boolean
Public glTrack_X As Long
Public glTrack_Y As Long

You'll need some means to assign values to the global variables that has scope within your Add-In's VB Project.

 

[D4rwin]

Works like a charm! Thanks Jerry.

Now to put the finishing touch on my project..I have a toggle button in my ribbon which calls the tracking module to assign values to the offset variables, but if the user slects "cancel" in the prompt, I'd like the ribbon toggle to turn off. Do you know how I can do this? Thanks again!

Currently the toggle looks as follows:

Sub GetPressed(control As IRibbonControl, pressed As Boolean)

    If pressed = True Then
        gbMyTog = True
        Call trgtSelect
    Else
        gbMyTog = False
    End If
End Sub    

Sub trgtSelect()
   if gbMyTog = True Then
   ---Code---
   ' Here there is a prompt for the user to select the desired cell to track but if he selects "Cancel" the ribbon toggle should turn off

End Sub

 

[Jerry Sullivan]

Are those two Subs in the workbook with the tables, or in your Add-In?

Similarly, is your RibbonX code in the workbook with the tables, or in your Add-In?

 

[D4rwin]

They are both in my Add-in

 

[Jerry Sullivan]

Here's one way using the Application.InputBox interface....

Sub trgtSelect()
'--purpose is to allow users to specify the x and y offsets
'    for the tracking by selecting a cell.
'  if user cancels, gbMyTog is to false to cancel tracking

 Dim rUserSel As Range

 If gbMyTog = True Then
   On Error Resume Next
   Set rUserSel = Application.InputBox( _
      Prompt:="My prompt..", _
      Title:="My title..", Type:=8)
   On Error GoTo 0
   If rUserSel Is Nothing Then
      '--user cancelled
      gbMyTog = False
   Else
      '--your code to set tracking
      glTrack_X = rUserSel.Row - ActiveCell.Row
      glTrack_Y = rUserSel.Column - ActiveCell.Column
   End If
 End If
End Sub

 

[D4rwin]

Hi Jerry,
Thanks for your response, but I'm afraid I didn't specify the issue clearly. I already have the tracker working as intended, but I dont know how to set the ribbon toggle to FALSE if gbMyTog = False. If the user cancels, the toggle button is still ON.

Sub GetPressed(control As IRibbonControl, pressed As Boolean)

    If pressed = True Then
        gbMyTog = True
        Call trgtSelect
    Else
        gbMyTog = False
    End If
    
End Sub
       
Sub trgtSelect()
Dim trgt As Range
Dim mBox_result As Integer
    
    Set trgt = Application.InputBox(Prompt:="Select the cell which you would like to track:", Title:="Tracker", Type:=8)
    If trgt.Count > 1 Then
        mBox_result = MsgBox("Please select only one cell", vbRetryCancel + vbCritical)
        Select Case mBox_result
            Case 4 'Retry
                Call trgtSelect
            Case Else 'Cancel
                gbMyTog = False
                Exit Sub
        End Select
    End If
    
    giTrack_X = trgt.Column - ActiveCell.Column
    giTrack_Y = trgt.Row - ActiveCell.Row
    
    If giTrack_Y <> 0 Then
        mBox_result = MsgBox("Your reference cell is not on the same row as as your current cell." _
        & vbNewLine & "Do you want to continue with this selection?", vbYesNoCancel + vbInformation)
        
        Select Case mBox_result
            Case 6 'Yes
            Case 7 'No
                Call trgtSelect
            Case Else
                gbMyTog = False
                Exit Sub
        End Select
    End If


End Sub

 

[RoryA]

You need to change pressed to False in your callback.

 

[D4rwin]

Yes but how do I call GetPressed after gbMyTog has been set to false in the module 'trgtSelect'?

 

[Jerry Sullivan]

I'm a relative newbie to RibbonX but working through Rory's advice in your recent related thread I was able to get the code below to work.
http://www.mrexcel.com/forum/excel-questions/788782-xml-ribbon-togglebutton.html

Merge with your existing xml...

Note that "******" should be replaced with "o n L o a d" (no spaces or quotes).

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
	******="TrackCellsInitialize" >
<ribbon>
<tabs>
<tab idMso="TabData">
<group id="Group1" label="Custom">
<toggleButton id="TbtnTracker" 
		label="Track Cells"
		screentip="Track Cells" 
		supertip="Select a cell to track" 
		size="large" 
		onAction="TbtnTrackerIsClicked" 
            		getPressed="GetPressed" 
            		imageMso="TRACK1"/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>

In a standard code module of your add-in...

Dim MyRibbon As IRibbonUI

'Callback for customUI.******
Sub TrackCellsInitialize(ribbon As IRibbonUI)
   Set MyRibbon = ribbon
   gbMyTog = False
End Sub

Sub ResetTbtnTracker()
'--invalidates the caches of this add-in’s controls
'  resets gbMyTog to synch with displayed tbtn
  MyRibbon.Invalidate
  gbMyTog = False
End Sub

'Callback for TbtnTracker getPressed
Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
   returnedVal = gbMyTog
End Sub

'Callback for TbtnTracker onAction
Sub TbtnTrackerIsClicked(control As IRibbonControl, pressed As Boolean)
  '--switch state of global variable
  gbMyTog = Not gbMyTog
  If gbMyTog Then Call trgtSelect
End Sub


Sub trgtSelect()
'--purpose is to allow users to specify the x and y offsets
'    for the tracking by selecting a cell.
'  if user cancels, ResetTbtnTracker is called which
'    sets gbMyTog false and resets tbtn on ribbon.

 Dim rUserSel As Range

 If gbMyTog = True Then
   On Error Resume Next
   Set rUserSel = Application.InputBox( _
      Prompt:="My prompt..", _
      Title:="My title..", Type:=8)
   On Error GoTo 0
   If rUserSel Is Nothing Then
      '--user cancelled
      ResetTbtnTracker
   Else
      '--your code to set tracking
      glTrack_X = rUserSel.Row - ActiveCell.Row
      glTrack_Y = rUserSel.Column - ActiveCell.Column
   End If
 End If
End Sub

Rory, I appreciate your pointing us in the good direction instead of providing a solution, as I learned quite a bit in sorting through this.