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?
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?
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
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
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
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
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
Semper in excretia sumus; solum profundum variat.
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
jwdesselle, I totally agree with you Computers or programmings are really fun!This is why I love computers, always more than one way to do what is needed.