View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Right click to change cell values

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 wrote:

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