Doubleclick to change cell color and text

[JaysDream]

Ok so I'm completely new to excel (and coding in general) and I just can't get it to work.

I managed to get this far, but it telly me an End If is missing. (And I'm sure a lot more is missing as well):

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("D5:Q68")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        Cancel = True
        If Target.Value <> "Nur Leitungsteam" Then
            Target.Value = True
        Else
            If Target.Value <> "" Then Target.Value = "x"
        End If
        If Target.Interior.ColorIndex = xlNone Then Target.Interior.ColorIndex = 4
        Else
            If Target.Interior.ColorIndex = 4 Then Target.Interior.ColorIndex = xlNone
        End If
    End If
End Sub

The function is supposed to be:

1. If a cell is blank and without text and you doubleclick it, it changes to green with an X in it
2. If a cell is blank with the text "Nur Leitungsteam" in it and you doubleclick it, it changes to green but the text stays
3. If a cell is green with an X and you doubleclick it again, it changes back to blank with no text
4. If a cell is green with the text "Nur Leitungsteam" and you doubleklick it again, it changes back to blank but the text stays

 

[Peter_SSs]

Welcome to the MrExcel board!

See if this does what you want. Test with a copy of your workbook.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Cancel = True
  Select Case True
    Case Target.Interior.Color = 16777215 And Target.Text = ""
      Target.Interior.Color = vbGreen
      Target.Value = "x"
    Case Target.Interior.Color = 16777215 And Target.Text = "Nur Leitungsteam"
      Target.Interior.Color = vbGreen
    Case Target.Interior.Color = vbGreen And Target.Text = "x"
      Target.Interior.Color = 16777215
      Target.ClearContents
    Case Target.Interior.Color = vbGreen And Target.Text = "Nur Leitungsteam"
      Target.Interior.Color = 16777215
  End Select
End Sub

 

[JaysDream]

Welcome to the MrExcel board!

See if this does what you want. Test with a copy of your workbook.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Cancel = True
  Select Case True
    Case Target.Interior.Color = 16777215 And Target.Text = ""
      Target.Interior.Color = vbGreen
      Target.Value = "x"
    Case Target.Interior.Color = 16777215 And Target.Text = "Nur Leitungsteam"
      Target.Interior.Color = vbGreen
    Case Target.Interior.Color = vbGreen And Target.Text = "x"
      Target.Interior.Color = 16777215
      Target.ClearContents
    Case Target.Interior.Color = vbGreen And Target.Text = "Nur Leitungsteam"
      Target.Interior.Color = 16777215
  End Select
End Sub

Thank you! That works perfectly. Only question is if it's possible to have the code to only work in the range D5:Q68?

Would it be enough to add

If Not Intersect(Target, Range("D5:Q68")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub

?
Or do I have to set the range somehow else?

 

[therevford]

i just tried a slightly different way from the previous post.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If ActiveCell.Interior.ColorIndex = 4 Then
ActiveCell.Interior.ColorIndex = 0
ActiveCell.Value = ""
Else
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Value = "X"
End If

End Sub

this can be expanded on for the other options that you need


Ta

Stu

 

[JaysDream]

i just tried a slightly different way from the previous post.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If ActiveCell.Interior.ColorIndex = 4 Then
ActiveCell.Interior.ColorIndex = 0
ActiveCell.Value = ""
Else
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Value = "X"
End If

End Sub

this can be expanded on for the other options that you need


Ta

Stu

That changes every cell I doubleclick into green with an x. It works, but I have to keep the text "Nur Leitungsteam" intact and not change it to and x.

The first tries I had were:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("D5:D68")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
Cancel = True
    If Target.Interior.ColorIndex = xlNone Then
        Target.Interior.ColorIndex = 4
    Else
       If Target.Interior.ColorIndex = 4 Then
        Target.Interior.ColorIndex = xlNone
    End If
End If
End Sub

But that didnt add an x to formerly blank cells

 

[Peter_SSs]

Or do I have to set the range somehow else?

No, your Not Intersect line is fine, but you don't need the Target.Cells.Count > 1 (unless you are dealing with merged cells) since for normal cells it is not possible to double-click on more than 1 at a time.

I have changed a few other things in my code as I think I wasn't dealing with the colour correctly. Try this instead.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("D5:Q68")) Is Nothing Then
    Cancel = True
    Select Case True
      Case Target.Interior.Pattern = xlNone And Target.Text = ""
        Target.Interior.Color = vbGreen
        Target.Value = "x"
      Case Target.Interior.Pattern = xlNone And Target.Text = "Nur Leitungsteam"
        Target.Interior.Color = vbGreen
      Case Target.Interior.Color = vbGreen And Target.Text = "x"
        Target.Interior.Pattern = xlNone
        Target.ClearContents
      Case Target.Interior.Color = vbGreen And Target.Text = "Nur Leitungsteam"
        Target.Interior.Pattern = xlNone
    End Select
  End If
End Sub

 

[JaysDream]

No, your Not Intersect line is fine, but you don't need the Target.Cells.Count > 1 (unless you are dealing with merged cells) since for normal cells it is not possible to double-click on more than 1 at a time.

I have changed a few other things in my code as I think I wasn't dealing with the colour correctly. Try this instead.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("D5:Q68")) Is Nothing Then
    Cancel = True
    Select Case True
      Case Target.Interior.Pattern = xlNone And Target.Text = ""
        Target.Interior.Color = vbGreen
        Target.Value = "x"
      Case Target.Interior.Pattern = xlNone And Target.Text = "Nur Leitungsteam"
        Target.Interior.Color = vbGreen
      Case Target.Interior.Color = vbGreen And Target.Text = "x"
        Target.Interior.Pattern = xlNone
        Target.ClearContents
      Case Target.Interior.Color = vbGreen And Target.Text = "Nur Leitungsteam"
        Target.Interior.Pattern = xlNone
    End Select
  End If
End Sub

Oh that's right, you can only doubleclick one cell at a time anyways. I only have merged cells for the title etc. The range the code is working for has no merged cells in it. The colour correction was to no colour instead of white right? Thanks! It didn't make much of a difference since the sheet is white anyways but I appreciate it a lot!

 

[Peter_SSs]

It didn't make much of a difference since the sheet is white anyways

You may have lost some cell borders with the first code though when the green colour was removed?

 

[JaysDream]

You may have lost some cell borders with the first code though when the green colour was removed?

No, surprisingly not. I have bold borders around everything and they didn't vanish when the green was removed.

 

[Peter_SSs]

No, surprisingly not. I have bold borders around everything and they didn't vanish when the green was removed.

Actually, I meant to cell grid lines, not cell borders. So yes, if you had borders they should have been fine. Anyway, go with whatever you like in that regard.