Use BeforeDoubleClick to place 1 or 4 character in a cell

[Tonso]

I have simple procedure that uses BeforeDoubleClick to place a green arrow in whatever cell i select.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Selection.Font
.Name = "Wingdings 3"
.FontStyle = "Regular"
.Size = 16
.Color = -16776961
End With
Selection.FormulaR1C1 = "ã"
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
ActiveCell.Offset(1, 0).Range("A1").

I would like to be able to doublelcick through several options, so...

If cell is blank then a double click will produce the green "up" arrow.
When the cell is then the a green arrow, another coulbleclick will produce a green "down" arrow,
if the cell has a green donw arrow, if will produce a red "up" arrow"
if the cell has a red "up" arrow, it wil produce a red "down" arrow.

I have no idea how to "click through" the choices to produce the desired arrow.

Thanks,

Tonso

 

[Claus Busch]

Hi Tonso,

Am Sat, 1 Mar 2014 10:12:37 -0800 (PST) schrieb Tonso:

If cell is blank then a double click will produce the green "up" arrow.
When the cell is then the a green arrow, another coulbleclick will produce a green "down" arrow,
if the cell has a green donw arrow, if will produce a red "up" arrow"
if the cell has a red "up" arrow, it wil produce a red "down" arrow.

try:

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

If Len(Target) = 0 Then
With Target
.Value = Chr(227)
.Font.Color = vbGreen
End With
ElseIf Asc(Target) = 227 And Target.Font.Color = vbGreen Then
With Target
.Value = Chr(228)
.Font.Color = vbGreen
End With
ElseIf Asc(Target) = 228 And Target.Font.Color = vbGreen Then
With Target
.Value = Chr(227)
.Font.Color = vbRed
End With
ElseIf Asc(Target) = 227 And Target.Font.Color = vbRed Then
With Target
.Value = Chr(228)
.Font.Color = vbRed
End With
End If
With Target
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Font
.Size = 16
.Name = "Wingdings 3"
End With
End With
Target.Offset(1, 0).Select
End Sub


Regards
Claus B.