Right click to change cell values

[Linn Pallesen]

I am trying to program a right click event to change cell values for columns
A:C. The code below works for column A only. When clicking on columns B or
C, the debug window appears. Any help would be very much appreciated.

Regards,
Linn Pallesen



Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)

Dim ValuesAB As Variant
Dim ValuesC As Variant
Dim resAB As Variant
Dim resC As Variant
Dim iCtr As Long

ValuesAB = Array("X", "")
ValuesC = Array("HOLD", "OK to FAB", "VOID", "")

If Target.Cells.count > 1 Then Exit Sub

If Intersect(Target, Me.Range("A:A")).Column Then
Cancel = True 'don't pop up the rightclick menu
resAB = Application.Match(Target.Value & "", ValuesAB, 0)
If IsNumeric(resAB) Then
If resAB = UBound(ValuesAB) + 1 Then
resAB = LBound(ValuesAB)
End If
Target.Value = ValuesAB(resAB)

ElseIf Intersect(Target, Me.Range("B:B")).Column Then
Cancel = True 'don't pop up the rightclick menu
resAB = Application.Match(Target.Value & "", ValuesAB, 0)
If IsNumeric(resAB) Then
If resAB = UBound(ValuesAB) + 1 Then
resAB = LBound(ValuesAB)
End If
Target.Value = ValuesAB(resAB)

ElseIf Intersect(Target, Me.Range("C:C")).Column Then
Cancel = True 'don't pop up the rightclick menu
resC = Application.Match(Target.Value & "", ValuesC, 0)
If IsNumeric(resC) Then
If resC = UBound(ValuesC) + 1 Then
resC = LBound(ValuesC)
End If
Target.Value = ValuesC(resC)
Else
MsgBox "Not a valid existing character"
'Target.Value = ValuesC(LBound(ValuesC))
End If
End If
End If
End If

End Sub

--

 

[Dave Peterson]

This seemed to work ok for me:

Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Dim ValuesAB As Variant
Dim ValuesC As Variant
Dim resAB As Variant
Dim resC As Variant
Dim iCtr As Long

ValuesAB = Array("X", "")
ValuesC = Array("HOLD", "OK to FAB", "VOID", "")

If Target.Cells.Count > 1 Then Exit Sub

If Not (Intersect(Target, Me.Range("A:B")) Is Nothing) Then
Cancel = True 'don't pop up the rightclick menu
resAB = Application.Match(Target.Value & "", ValuesAB, 0)
If IsNumeric(resAB) Then
If resAB = UBound(ValuesAB) + 1 Then
resAB = LBound(ValuesAB)
End If
Target.Value = ValuesAB(resAB)
End If
Else
If Not (Intersect(Target, Me.Range("C:C")) Is Nothing) Then
Cancel = True 'don't pop up the rightclick menu
resC = Application.Match(Target.Value & "", ValuesC, 0)
If IsNumeric(resC) Then
If resC = UBound(ValuesC) + 1 Then
resC = LBound(ValuesC)
End If
Target.Value = ValuesC(resC)
Else
MsgBox "Not a valid existing character"
'Target.Value = ValuesC(LBound(ValuesC))
End If
End If
End If

End Sub

 

[Linn Pallesen]

Dave,
I cannot thank you enough. It works perfectly.

 

[Dave Peterson]

Glad it worked!

Dave,
I cannot thank you enough. It works perfectly.