VBA custom right click menu, onaction

[akramer08]

I have a custom right click menu. I have a loop using values of cells in a range as the captions in a submenu. I want the onaction for each button in the submenu to insert a value of a cell the is next to the cell that was used as the caption for that button.

If the button labeled "Call Center - Center Interpreted Information Incorrectly", I want the onaction procedure to insert the code in col A in the same row as the name of that button, and insert it into a cell. Here is my code so far.

With Application.CommandBars("Cell").Controls


    Set SubMenuItem1 = .Add(Type:=msoControlPopup, ID:=1)


    With SubMenuItem1
        .Caption = "Add Problem Code"
        .OnAction = ""
        .BeginGroup = False
    End With


    Dim rCell As Range
    Dim rRng As Range


    Set rRng = Sheets("Code Conversion").Range("A2:A87")


    For Each rCell In rRng.Cells


        Desc = rCell.Offset(0, 7)
        Code = rCell


        With SubMenuItem1.Controls.Add
            .Caption = Desc
            .OnAction = "AddCode"
            .BeginGroup = False
        End With


    Next rCell


End With

 

[akramer08]

I guess my question is, can you use the name of the submenu item that was clicked as a variable in the next sub routine? This way I can find that submenu button's caption on the Code Conversion sheet, and return an offset value.

 

[John_w]

I'm not really sure which cell you mean when you say 'next cell'. Is it 1 column to the left, or the right, or what? You have to be more specific. But see if the following code helps:

'<<<< Top of your code snipped >>>>

        onAction = "'AddCode " & Q(rCell.Worksheet.Name) & ", " & Q(rCell.Address) & "'"

        With SubMenuItem1.Controls.Add
            .Caption = Desc
            .onAction = onAction
            .BeginGroup = False
        End With

    Next rCell


End With
End Sub

Private Function Q(s As String) As String
    Q = Chr(34) & s & Chr(34)
End Function

Sub AddCode(sheetName As String, cellAddress As String)
    MsgBox sheetName & " " & cellAddress
    MsgBox Worksheets(sheetName).Range(cellAddress).Address
End Sub

Notice how AddCode has been defined to accept 2 string arguments containing the sheet name and cell address, and then the 2nd MsgBox shows how to use these strings in a sheet and range reference.

 

[akramer08]

That is basically what Im looking for. The only thing I need now is inserting the value in that found cell into a cell on the original sheet. The first message box shows "Code Conversion $A$2". I need to take the value in sheet Code Conversion cell $A$2 and insert it in the ActiveCell.Offset(0,5). If that doesnt make sense I apologize I have a lot of distractions right now.

 

[John_w]

One of these lines should do it:

Sub AddCode(sheetName As String, cellAddress As String)
    'MsgBox sheetName & " " & cellAddress
    'MsgBox Worksheets(sheetName).Range(cellAddress).Address
    
    'take the value in this cell and insert it in the ActiveCell.Offset(0,5).
    ActiveCell.Offset(0, 5).Value = Worksheets(sheetName).Range(cellAddress).Value
    
    'Or
    Worksheets(sheetName).Range(cellAddress).Copy ActiveCell.Offset(0, 5)
End Sub

 

[akramer08]

Thanks, works perfectly.

Would you mind telling me how this line works? Ive never seen anything code like that before.

OnAction = "'AddCode " & Q(rCell.Worksheet.Name) & ", " & Q(rCell.Address) & "'"

 

[John_w]

It creates a string in the correct format for the OnAction property, specifying the name of the routine to call and any arguments the routine needs. String arguments must be surrounded by double quotes, which the Q function does. Each argument is separated by a comma and the whole string is then surrounded by single quotes.

See http://www.mrexcel.com/forum/excel-questions/309352-adding-option-right-click.html#post1523107 for other OnAction examples.