Excel - 'X' in cell upon clicking 4

[mgilbertson]

I am looking for a way to enter an 'X' in a cell when double clicked. The cell next to it should then be clear. See example below.
If I click on cell 'E20', then I want an 'X' to appear, and cell 'F20' is blank, and vice versa.

Thank you.

 

[SkipVought]

Hi,

What is the full range of cells that you want to respond in this way? I’m assuming that its rowa 19:39 in columns E:F.

Right click the Sheet Tab and select View code. The Code Window for this sheet will be displayed.

Above the Code Window are two Drop Downs.
In the LEFT Drop Down, select Worksheet.
In the RIGHT Drop Down, select Double Click

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

    If Target.Count > 1 Then Exit Sub
    If Target.Value <> “” Then Exit Sub

    Set rE = Range(Cells(19, “E”), Cells(39, “E”))
    Set rF = Range(Cells(19, “F”), Cells(39, “F”))

    If Not Intersect(Target, rE) Is Nothing Then
       If Intersect(Target.EntireRow, rF).Value = “” Then
          Intersect(Target.EntireRow, rF).Value = “X”
       End If
    Else
       If Not Intersect(Target, rF) Is Nothing Then
          If Intersect(Target.EntireRow, rE).Value = “” Then
             Intersect(Target.EntireRow, rE).Value = “X”
          End If
       End If
    End If
End sub

Please substitute your oun QUOTES for my inadequate iPad quotes.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[JG2828]

Skip,
You need to turn off "smart punctuation" in your iPad. Go to Settings / General / Keyboards / and un-tick Smart Punctuation. That will get rid of the useless smart quotes. Do the same on your iPhone if you have one.

edited to add: Also, in MS Word, you can turn them off by clicking File / Options / Proofing / AutoCorrect Options / Uncheck "Replace: Straight Quotes with Smart Quotes"

 

[SkipVought]

"Smart punctuation" is OFF, from this time henceforth or even hencefifth *hic*!

I thank you, JG2828!

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[JG2828]

Skip,
I had to make some modifications to get it to work. I also added Cancel = True at the end because it was causing some issues.
This version is tested and working for cells E19 to F39

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

    If Target.Count > 1 Then Exit Sub
    If Target.Value <> "" Then Exit Sub

    Set rE = Range(Cells(19, "E"), Cells(39, "E"))
    Set rF = Range(Cells(19, "F"), Cells(39, "F"))

    If Not Intersect(Target, rE) Is Nothing Then
       If Intersect(Target.EntireRow, rE).Value = "" Then
          Intersect(Target.EntireRow, rE).Value = "X"
          Intersect(Target.EntireRow, rF).Value = ""
       End If
    Else
       If Not Intersect(Target, rF) Is Nothing Then
          If Intersect(Target.EntireRow, rF).Value = "" Then
             Intersect(Target.EntireRow, rF).Value = "X"
             Intersect(Target.EntireRow, rE).Value = ""
          End If
       End If
    End If
    Cancel = True
End Sub

 

[SkipVought]

Thanks!

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[mgilbertson]

Thank you for your help. This worked great. I just have one change.

There are actually two sections that need this. The original as shown, and also E/F74 - E/F106. Is it possible to do two sections?

Thank you.

 

[JG2828]

Sure, here you go. You can make as many ranges as you need. Just follow the same pattern.

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

    If Target.Count > 1 Then Exit Sub
    If Target.Value <> "" Then Exit Sub

    Set rE = Range(Cells(19, "E"), Cells(39, "E"))
    Set rF = Range(Cells(19, "F"), Cells(39, "F"))

    If Not Intersect(Target, rE) Is Nothing Then
       If Intersect(Target.EntireRow, rE).Value = "" Then
          Intersect(Target.EntireRow, rE).Value = "X"
          Intersect(Target.EntireRow, rF).Value = ""
       End If
    Else
       If Not Intersect(Target, rF) Is Nothing Then
          If Intersect(Target.EntireRow, rF).Value = "" Then
             Intersect(Target.EntireRow, rF).Value = "X"
             Intersect(Target.EntireRow, rE).Value = ""
          End If
       End If
    End If
    
    Set rE = Range(Cells(74, "E"), Cells(106, "E"))
    Set rF = Range(Cells(74, "F"), Cells(106, "F"))
    If Not Intersect(Target, rE) Is Nothing Then
       If Intersect(Target.EntireRow, rE).Value = "" Then
          Intersect(Target.EntireRow, rE).Value = "X"
          Intersect(Target.EntireRow, rF).Value = ""
       End If
    Else
       If Not Intersect(Target, rF) Is Nothing Then
          If Intersect(Target.EntireRow, rF).Value = "" Then
             Intersect(Target.EntireRow, rF).Value = "X"
             Intersect(Target.EntireRow, rE).Value = ""
          End If
       End If
    End If
    Cancel = True
End Sub

 

[mgilbertson]

Thank you very much!!! Works perfectly!!

 

[JG2828]

No problem. Skip was the mastermind here, I just modified his idea.

 

[SkipVought]

Here's how I'd do it...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rE As Range, rF As Range, i As Integer, lRow(1,2)

    lRow(0,0) = 19
    lRow(0,1) = 39
    lRow(1,0) = 74
    lRow(1,1) = 106

    If Target.Count > 1 Then Exit Sub
    If Target.Value <> "" Then Exit Sub

    For i = 0 to 1
       
       Set rE = Range(Cells(lRow(i,0), "E"), Cells(lRow(i,1), "E"))
       Set rF = Range(Cells(lRow(i,0), "F"), Cells(lRow(i,1), "F"))

       If Not Intersect(Target, rE) Is Nothing Then
          If Intersect(Target.EntireRow, rE).Value = "" Then
             Intersect(Target.EntireRow, rE).Value = "X"
             Intersect(Target.EntireRow, rF).Value = ""
          End If
       Else
          If Not Intersect(Target, rF) Is Nothing Then
             If Intersect(Target.EntireRow, rF).Value = "" Then
                Intersect(Target.EntireRow, rF).Value = "X"
                Intersect(Target.EntireRow, rE).Value = ""
             End If
          End If
       End If
    Next
    
    Cancel = True
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[GregLocock]

Another approach, which is probably harder, would be to create a whole lot of user forms with two radio buttons on each.

Cheers

Greg Locock


New here? Try reading these, they might help FAQ731-376

http://eng-tips.com/market.cfm?

 

[SkipVought]

Actually, rather than having an array hold the values, I'd put the range limits in a table on a new sheet and read the table to assign the ranges, whether there be one, two or more ranges. Much easier to maintain a table than change code when different ranges are required.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Agent666]

Probably easy/clearer to incorporate a named range on the sheet for the ranges?

       Set rE = Range(Cells(lRow(i,0), "E"), Cells(lRow(i,1), "E"))

becomes

       Set rE = Range("my_range")

and you don't need the 1Row definitions as well to further simplify things? (Keep in mind have not tested this, but should work?)

 

[Agent666]

Just a further thought you could further automate adding further ranges by adding a unique number to the end, like my_range_1, my_range_2, etc. And loop through them using a string assembled like

Range("my_range_" & k)