How can I use BeforeDoubleClick to cycle through more than two colours?-CodePudding

I have a worksheet that plots my personal targets down the left with the methods of completion along the top. For cell in the matrix, I want to be able to double click to cycle between having an empty cell with red background, a green cell saying "Planned", and a green cell saying "Complete" with strikethrough.

At the moment I am able to use BeforeDoubleClick to toggle between the red cell and the "Complete" cell with strikethrough, but I can't find anyone online explaining how to cycle between all three using only double click. The code I have so far is:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Value = "Complete"
        Case True: Target.Value = ""
            With Target.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
            With Target.Font
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = -0.249977111117893
            End With
            Target.Font.Italic = False
            Target.Font.Bold = False
            With Target.Font
                .Name = "Calibri"
                .Size = 11
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = -0.249977111117893
                .ThemeFont = xlThemeFontMinor
            End With
        Case Else: Target.Value = "Complete"
            With Target.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
            With Target.Font
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = -0.249977111117893
            End With
            Target.Font.Bold = False
            Target.Font.Bold = True
            Target.Font.Italic = True
            With Target.Font
                .Name = "Calibri"
                .FontStyle = "Bold Italic"
                .Size = 11
                .Strikethrough = True
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = -0.249977111117893
                .ThemeFont = xlThemeFontMinor
            End With
End Select
End Sub

I know I could use BeforeLeftClick, but I'd prefer to just keep it all using the same shortcut.

Thanks to anyone who can help!

Oh also, I've been coding in VBA for about a year but it's all self-taught so you'll have to keep explanations simple!

CodePudding user response：

My advice: Separate the tasks. Don't put too much logic into the trigger (the event routine) itself. In the following example, the event routine just checks if the target cells qualifies for the logic: You don't want to overwrite the content of the first columns or the header row. If okay, it calls a routine (cycleStatus) that does the work.

The routine itself first sets the value of the cell. It uses an If-ElseIf construct, but you can also use SelectCase, it's just a matter of taste.

After setting the content, the cell is formatted. You have a lot of unnecessary code, probably as a result of the macro recorder. I reduced it to the necessary commands to set the background color and the strike through, maybe you need to adapt it to set the color you want, change also the font color and so on.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Ensure that you set only cells in the middle of your table.
    If Target.Row > 2 And Target.Column > 4 And Cells(Target.Row, 4) <> "" And Cells(2, Target.Column) <> "" Then
        cycleStatus Target
    End If
End Sub


Sub cycleStatus(cell As Range)

    ' --- Step 1: Set cell content
    If cell.Value = "" Then
        cell.Value = "Planned"
    ElseIf cell.Value = "Planned" Then
        cell.Value = "Complete"
    Else
        cell.Value = ""
    End If
    ' The following lines would do the same:
    'Select Case cell.Value
    '    Case ""
    '        cell.Value = "Planned"
    '    Case "Planned"
    '        cell.Value = "Complete"
    '    Case Else
    '        cell.Value = ""
    'End Select
       
    ' --- Step 2: Format cell
    With cell.Interior
        .ThemeColor = IIf(cell.Value = "", xlThemeColorAccent2, xlThemeColorAccent6)
        .TintAndShade = 0.6
    End With
    
    With cell.Font
        .Strikethrough = (cell.Value = "Complete")
    End With
End Sub

CodePudding user response：

You would be better off with using if statements for this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Value = "Complete" Then
    Target.Value = ""
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    With Target.Font
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
    End With
    Target.Font.Italic = False
    Target.Font.Bold = False
    With Target.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
        .ThemeFont = xlThemeFontMinor
    End With
ElseIf Target.Value = "" Then
    Target.Value = "Planned"
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    With Target.Font
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
    End With
    Target.Font.Bold = False
    Target.Font.Bold = True
    Target.Font.Italic = True
    With Target.Font
        .Name = "Calibri"
        .FontStyle = "Bold Italic"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .ThemeFont = xlThemeFontMinor
    End With
ElseIf Target.Value = "Planned" Then
    Target.Value = "Complete"
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    With Target.Font
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
    End With
    Target.Font.Bold = False
    Target.Font.Bold = True
    Target.Font.Italic = True
    With Target.Font
        .Name = "Calibri"
        .FontStyle = "Bold Italic"
        .Size = 11
        .Strikethrough = True
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .ThemeFont = xlThemeFontMinor
    End With
End If

End Sub