Doubleclick to change cell color and text

JaysDream

New Member
Joined
Oct 22, 2020
Messages
6
Office Version
  1. 2013
Platform
  1. Windows
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):

VBA Code:
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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Welcome to the MrExcel board!

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

VBA Code:
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
 
Upvote 0
Welcome to the MrExcel board!

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

VBA Code:
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
VBA Code:
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?
 
Upvote 0
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
 
Upvote 0
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:
VBA Code:
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
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0
Solution
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.

VBA Code:
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!
 
Upvote 0
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.
 
Upvote 0
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. :)
 
Upvote 0

Forum statistics

Threads
1,213,492
Messages
6,113,967
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top