Consulting

Results 1 to 8 of 8

Thread: Paste contents into cell that has color

  1. #1

    Paste contents into cell that has color

    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?

  2. #2
    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

  3. #3
    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

  4. #4
    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

  5. #5
    VBAX Regular
    Joined
    Jan 2018
    Posts
    52
    Location
    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

  6. #6
    VBAX Mentor paulked's Avatar
    Joined
    Apr 2006
    Posts
    492
    Location
    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.

  7. #7
    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

  8. #8
    VBAX Regular
    Joined
    Jan 2018
    Posts
    52
    Location
    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!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •