Need help VBA code to highlight cells

[rvillaneda]

Fairly new to VBA and need some help. I have the following data in excel sheet1 in the range C2:D10. I'd like to be able to double click on either the Category or the Volume cell within the range and have that data (for the respective row) copied to another location. I have found a way to do that via the VBA code below; however, I would also like that same selection to be shaded upon the double click. For example, if I double click on the cell containing value of "Carrots", I'd like that cell and the associated volume cell (i.e. 112) to be highlighted. Alternatively, if I end up double clicking a different row the highlight should turn off and only the newly selected should be highlighted.

The VBA code to transfer the selected data seems to be working well. How do I add code so I can get it to highlight column C and D for the selected row?

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Category

[/TD]
[TD]Volume[/TD]
[/TR]
[TR]
[TD]Bananas[/TD]
[TD]212[/TD]
[/TR]
[TR]
[TD]Carrots[/TD]
[TD]112[/TD]
[/TR]
[TR]
[TD]Zucchini[/TD]
[TD]153[/TD]
[/TR]
[TR]
[TD]Asparagus[/TD]
[TD]311[/TD]
[/TR]
[TR]
[TD]Potatoes[/TD]
[TD]112[/TD]
[/TR]
[TR]
[TD]Squash[/TD]
[TD]89[/TD]
[/TR]
[TR]
[TD]Beets[/TD]
[TD]45[/TD]
[/TR]
[TR]
[TD]Plums[/TD]
[TD]125[/TD]
[/TR]
</tbody>[/TABLE]


Current VBA Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column >= 3 And Target.Column <= 4 And Target.Row >= 2 And Target.Row <= 10 Then
Cancel = True
If Target.Value <> "" Then
Sheet3.Range("B3") = Range("c" & Target.Row).Value
Sheet3.Range("C3") = Range("d" & Target.Row).Value








End If
End If


End Sub

 

[Meesam_ali]

The solution to your problem seems advanced as far as worksheet events is considered. See if the below is sufficient. I am working on full solution as of now.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set ws = ThisWorkbook.Sheets("color")
If Target.Column >= 3 And Target.Column <= 4 And Target.Row >= 2 And Target.Row <= 10 Then
    Cancel = True
    If Target.Value <> "" Then
        k = Target.Row
        ws.Range("A3") = Range("C" & k).Value
        ws.Range("B3") = Range("D" & k).Value
        If Range("C" & k).Interior.ColorIndex = 6 Then
            Range("C" & k).Interior.Color = xlNone
            Range("D" & k).Interior.Color = xlNone
        Else
            Range("C" & k).Interior.ColorIndex = 6
            Range("D" & k).Interior.ColorIndex = 6
        End If
    End If
End If


End Sub

 

[rvillaneda]

Sorry Meesam_ali - that didn't seem to work. I copied the VBA code as you listed it and received an error message stating runtime error "9" subscript out of range. When I select the debug, it highlights the second line in your code (set ws - ThisWorkbook.Sheets("color") and states it is out of range.

 

[Akuini]

Hi, rvillaneda
You may try this code:

[color=blue]Private[/color] [color=blue]Sub[/color] Worksheet_BeforeDoubleClick[B]([/B][color=blue]ByVal[/color] Target [color=blue]As[/color] Range[B],[/B] Cancel [color=blue]As[/color] [color=blue]Boolean[/color][B])[/B]
    [color=blue]If[/color] [color=blue]Not[/color] Intersect[B]([/B]Target[B],[/B] Range[B]([/B][color=brown]"C2:D10"[/color][B]))[/B] [color=blue]Is[/color] [color=blue]Nothing[/color] [color=blue]Then[/color]
            Cancel [B]=[/B] [color=blue]True[/color]
            [color=blue]If[/color] Target.Value [B]<>[/B] [color=brown]""[/color] [color=blue]Then[/color]
                x [B]=[/B] Target.Row
                Sheet3.Range[B]([/B][color=brown]"B3"[/color][B])[/B] [B]=[/B] Range[B]([/B][color=brown]"c"[/color] [B]&[/B] x[B]).[/B]Value
                Sheet3.Range[B]([/B][color=brown]"C3"[/color][B])[/B] [B]=[/B] Range[B]([/B][color=brown]"d"[/color] [B]&[/B] x[B]).[/B]Value
               
                [i][color=seagreen]'clear previous highlight[/color][/i]
                Range[B]([/B][color=brown]"C2:D10"[/color][B]).[/B]Interior.Color [B]=[/B] xlNone
                Range[B]([/B]Cells[B]([/B]x[B],[/B] [color=brown]"C"[/color][B]),[/B] Cells[B]([/B]x[B],[/B] [color=brown]"D"[/color][B])).[/B]Interior.Color [B]=[/B] vbYellow
               
            [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]End[/color] [color=blue]If[/color]
 
[color=blue]End[/color] [color=blue]Sub[/color]

 

[Meesam_ali]

Sorry Meesam_ali - that didn't seem to work. I copied the VBA code as you listed it and received an error message stating runtime error "9" subscript out of range. When I select the debug, it highlights the second line in your code (set ws - ThisWorkbook.Sheets("color") and states it is out of range.

Sorry i had put explicit name of sheet. Good that "Akuini" already posted solution and that works perfectly.

 

[rvillaneda]

Thank you "Akuini" - this worked perfectly!

 

[rvillaneda]

Thank you so much Akuini - this worked perfectly!

 

[Akuini]

You're welcome & thanks for replying