Jason,
Here's what I have so far.
This is what happens.
If you select any cell in A1:A50, it cycles through the colours green, red,
blue, none, and sets the column B cell to the value 1,2,3, or ""
accordingly. It then moves the selection over to column B (this was to
enable cycling through A without having to go and select other cells).
If you right-click any cell in A1:A50, it checks column B for a 1 or a 2. If
it is, it cycles column C through the values 1-5, and constructs the text
for that value. If C is already 5, nothing happens (should it revert to
blank?
One more question . What should happen if column A is red, and column C has
a value and the A is selected again. This will turn A blue, B to 3, but
should C be left alone or cleared?
Here's the code. Replace all the other code with this.
Option Explicit
Dim oldValue
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)
If Not Intersect(Target, Range("A1:A50")) Is Nothing Then
With Target
.Offset(0, 1) = oldValue
SetColour Target
If .Count > 1 Then
Cancel = True
ElseIf .Offset(0, 1) = 1 Or _
.Offset(0, 1) = 2 Then
If .Offset(0, 2).Value = "" Then
.Offset(0, 2).Value = "(1) " & .Value
ElseIf Mid(.Offset(0, 2).Value, 2, 1) <> 5 Then
.Offset(0, 2).Value = "(" & Mid(.Offset(0, 2).Value, 2,
1) + 1 & _
") " & .Value
End If
End If
End With
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A50")) Is Nothing Then
If Target.Count = 1 Then
With Target
oldValue = .Offset(0, 1).Value
Select Case .Offset(0, 1).Value
Case 1: .Offset(0, 1).Value = 2
Case 2: .Offset(0, 1).Value = 3
Case 3: .Offset(0, 1).Value = ""
Case Else: .Offset(0, 1).Value = 1
End Select
End With
SetColour Target
End If
Target.Offset(0, 1).Select
End If
End Sub
Private Sub SetColour(Target As Range)
With Target
Select Case .Offset(0, 1).Value
Case 1: .Interior.ColorIndex = 10 'Green
Case 2: .Interior.ColorIndex = 3 'Red
Case 3: .Interior.ColorIndex = 5 'Blue
Case Else: .Interior.ColorIndex = xlColorIndexNone
End Select
End With
End Sub
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)