I had a similar set of code, two separate routines, perhaps a little longer though...

Code:
Option Explicit

Dim oBtnClk                     As Shape
Dim WS                          As Worksheet
Dim rCell                       As Range
Dim arr()                       As String
Dim iPos                        As Long

Const sArr                      As String = "Txt1, Txt2, Txt3, Txt4, Txt5, Txt6, Txt7, Txt8, Txt9, Txt10, Txt11, Txt12"
Const sTargetSheet              As String = "Sheet1"
Const sTargetCell               As String = "A1"

Sub Increase()
    Set oBtnClk = Nothing
    Set WS = Worksheets(sTargetSheet)
    Set rCell = WS.Range(sTargetCell)
    On Error Resume Next
    Set oBtnClk = WS.Shapes(Application.Caller)
    arr = Split(sArr, ", ")
    iPos = WorksheetFunction.Match(rCell.Value, arr(), 0)
    On Error GoTo 0
    If oBtnClk Is Nothing Then Exit Sub
    If iPos = 0 Then
        'not set yet
        rCell.Value = arr(LBound(arr))
        Exit Sub
    End If
    If iPos - 1 = UBound(arr) Then Exit Sub
    rCell.Value = arr(iPos)
End Sub

Sub Decrease()
    Set oBtnClk = Nothing
    Set WS = Worksheets(sTargetSheet)
    Set rCell = WS.Range(sTargetCell)
    On Error Resume Next
    Set oBtnClk = WS.Shapes(Application.Caller)
    arr = Split(sArr, ", ")
    iPos = WorksheetFunction.Match(rCell.Value, arr(), 0)
    On Error GoTo 0
    If oBtnClk Is Nothing Then Exit Sub
    If iPos = 0 Then
        'not set yet
        rCell.Value = arr(LBound(arr))
        Exit Sub
    End If
    If iPos - 1 = LBound(arr) Then Exit Sub
    rCell.Value = arr(iPos - 2)
End Sub
This would actually require two buttons. If you don't want to use buttons, and are good with using the worksheet cells, we can utilize click and right click events, but not right clicking on an object. We could perhaps utilize some API's to determine where the mouse clicked, and if it was over the top of a button, but I think it'd be a little more in-depth than workarounds such as these.

HTH

Regards,
Zack Barresse