| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Right click to change cell values
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 -- |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Right click to change cell values
Dave,
I cannot thank you enough. It works perfectly. -- Regards, Linn Pallesen "Dave Peterson" wrote: 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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Right click to change cell values
Glad it worked!
Linn Pallesen wrote: Dave, I cannot thank you enough. It works perfectly. -- Regards, Linn Pallesen "Dave Peterson" wrote: 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 -- Dave Peterson |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Change Cell colour on click | Excel Discussion (Misc queries) | |||
| I need to set pointer to change a cell(s)with 1 click | Excel Worksheet Functions | |||
| on double click change cell color | Excel Programming | |||
| how do I: click in cell and make it change color? | Excel Programming | |||
| Want to be able to click on a cell and have a list box appear to give values to populate a cell | Excel Programming | |||
Linear Mode
