Copying yellow cells in a range to another column on the same sheet with VBA

paydog23

New Member
Joined
Jul 12, 2017
Messages
28
Office Version
  1. 365
Platform
  1. Windows
I have a dataset that contains yellow cells (each yellow cell represents the final treatment plant or TP in a flow path) from Range("A2: F841"). Since the yellow cells are spread out randomly among the columns A to F, I would like to use VBA to copy them all as a single range in column J. I am doing this so that each well in column I has a corresponding final TP. Here's a screenshot of my spreadsheet

YellowCells.jpg
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
If you put the color manually as a standard color, that is, it is not conditional formatting. Try the following:

VBA Code:
Sub Copying_yellow_cells()
  Dim i As Long, j As Long
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Columns("F").Column
      If Cells(i, j).Interior.Color = vbYellow Then
        Cells(i, "J").Value = Cells(i, j).Value
        Exit For
      End If
    Next
  Next
End Sub
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
Thanks I actually just posted another related question--I had to manually color all those cells yellow but in the future I'd like to use VBA. I posted that question in this thread:

 
Upvote 0
If you put the color manually as a standard color, that is, it is not conditional formatting. Try the following:

VBA Code:
Sub Copying_yellow_cells()
  Dim i As Long, j As Long
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Columns("F").Column
      If Cells(i, j).Interior.Color = vbYellow Then
        Cells(i, "J").Value = Cells(i, j).Value
        Exit For
      End If
    Next
  Next
End Sub

How would you copy the cells if you did use conditional formatting?
 
Upvote 0
If you put the color manually as a standard color, that is, it is not conditional formatting. Try the following:

VBA Code:
Sub Copying_yellow_cells()
  Dim i As Long, j As Long
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Columns("F").Column
      If Cells(i, j).Interior.Color = vbYellow Then
        Cells(i, "J").Value = Cells(i, j).Value
        Exit For
      End If
    Next
  Next
End Sub
I am not sure if the following will be faster (it will do less overall looping), but it is a alternative macro that will also work for manually colored cells...
VBA Code:
Sub MoveYellowCellValuesToColumnJ()
  Dim Addr As String, Cell As Range
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = vbYellow
  With Range("A1", Cells(Rows.Count, "F").End(xlUp))
    Set Cell = .Find("", SearchFormat:=True)
    If Not Cell Is Nothing Then
      Addr = Cell.Address
      Do
        Intersect(Cell.EntireRow, Columns("J")) = Cell.Value
        Set Cell = .Find("", Cell, SearchFormat:=True)
      Loop While Not Cell Is Nothing And Cell.Address <> Addr
    End If
  End With
  Application.FindFormat.Clear
End Sub
 
Upvote 0
I am not sure if the following will be faster (it will do less overall looping), but it is a alternative macro that will also work for manually colored cells...
VBA Code:
Sub MoveYellowCellValuesToColumnJ()
  Dim Addr As String, Cell As Range
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = vbYellow
  With Range("A1", Cells(Rows.Count, "F").End(xlUp))
    Set Cell = .Find("", SearchFormat:=True)
    If Not Cell Is Nothing Then
      Addr = Cell.Address
      Do
        Intersect(Cell.EntireRow, Columns("J")) = Cell.Value
        Set Cell = .Find("", Cell, SearchFormat:=True)
      Loop While Not Cell Is Nothing And Cell.Address <> Addr
    End If
  End With
  Application.FindFormat.Clear
End Sub
Thank you--do you what changes I'd need to make so that the macro works for conditionally formatted cells?
 
Upvote 0
Try this (not tested)

VBA Code:
Sub Copying_yellow_cells()
  Dim i As Long, j As Long
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Columns("F").Column
      If Cells(i, j).DisplayFormat.Interior.Color = vbYellow Then
        Cells(i, "J").Value = Cells(i, j).Value
        Exit For
      End If
    Next
  Next
End Sub
 
Upvote 0
How would you copy the cells if you did use conditional formatting?
Try this modification to Dante's code...
Code:
Sub Copying_yellow_cells()
  Dim i As Long, j As Long
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Columns("F").Column
      If Cells(i, j).DisplayFormat.Interior.Color = vbYellow Then
        Cells(i, "J").Value = Cells(i, j).Value
        Exit For
      End If
    Next
  Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,182
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top