Paste contents into cell that has color

[jwdesselle]

Is there a way to paste/copy contents of a cell into the cell on that row with a background color?
Capture.JPG

I'm wanting which ever cell on the left is clicked/double clicked to populate the cell to the right that is in gray. Is this possible?

[jwdesselle]

Here is what I have so far:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C3:I" & Rows.Count)) Is Nothing Then Exit Sub
Range("K3").Value = Target.Offset(0, 0).Value
End Sub

[jwdesselle]

I've gotten this to at least paste on the same row, but how do I make it paste into the column/cell with color?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C3:I26,C30:I50")) Is Nothing Then Exit Sub
Range("K" & ActiveCell.Row).Value = Target.Offset(0, 0).Value
'color is 15
End Sub

[jwdesselle]

I'm not sure if this is the best way, but I did figure something out for this:

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

If Intersect(Target, Range("C3:I26,C30:I50")) Is Nothing Then Exit Sub

Dim ws As Worksheet
Set ws = Sheets("Sheet1")

If ws.Range("K" & ActiveCell.Row).Interior.ColorIndex = 15 Then
    Range("K" & ActiveCell.Row).Value = Target.Offset(0, 0).Value
Else
If ws.Range("L" & ActiveCell.Row).Interior.ColorIndex = 15 Then
    Range("L" & ActiveCell.Row).Value = Target.Offset(0, 0).Value
Else
If ws.Range("M" & ActiveCell.Row).Interior.ColorIndex = 15 Then
    Range("M" & ActiveCell.Row).Value = Target.Offset(0, 0).Value
End If
End If
End If
'color is 15

End Sub

[yujin]

Hi, jwdesselle

I have modified your code like below.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("C3:I26,C30:I50")) Is Nothing Then Exit Sub
    
    Dim Cell As Range
    Cancel = True
    For Each Cell In Range("K" & Target.Row).Resize(, 3)
        If Cell.Interior.ColorIndex = 15 Then
            Cell.Value = Target.Value
            Exit For
        End If
    Next Cell
End Sub

[paulked]

Or

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Long
    If Intersect(Target, Range("C3:I26,C30:I50")) Is Nothing Then Exit Sub
    For i = 11 To 13
        If Cells(Target.Row, i).Interior.ColorIndex = 15 Then Cells(Target.Row, i) = Target
    Next
    Cancel = True
End Sub

[jwdesselle]

Thanks yujin and paulked, both solutions you submitted worked perfectly. This is why I love computers, always more than one way to do what is needed.

Thanks again,
John

[yujin]

This is why I love computers, always more than one way to do what is needed.

jwdesselle, I totally agree with you Computers or programmings are really fun!