PDA

View Full Version : Paste contents into cell that has color



jwdesselle
09-20-2019, 11:54 AM
Is there a way to paste/copy contents of a cell into the cell on that row with a background color?
25126

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
09-20-2019, 11:57 AM
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
09-20-2019, 01:13 PM
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
09-20-2019, 02:15 PM
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
09-22-2019, 12:28 AM
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
09-23-2019, 01:36 AM
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
09-23-2019, 06:57 AM
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
09-24-2019, 06:50 AM
This is why I love computers, always more than one way to do what is needed.

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