VBA - How to copy rows based on by cells that are conditional formatted

Question

Original Post

I am fairly new to VBA and until now I managed to do everything. I am stuck at a "basic-looking" task, which is to copy a row from a sheet to another sheet, based by the background color of the cells. The background is done by conditional formatting and are only red if the values are out of tolerance.

I tried multiple things, couldn't do it with anything yet. Not even close.

My last try was with Cells.DisplayFormat.Interior.Color = vbRed, but I couldn't manage the searching row-by-row. I also tried using for the For cycle AllRows = ActiveSheet.UsedRange.Rows.Count so that it only goes to the last used row, but I got stuck pretty quickly.

If you can help me with this, I would appreciate it very much. If I missed any crucial part of the problem, please ask, I will gladly provide it.

Thanks!

Solution

    Sub copy_formatted()
    
    Dim startRange As Range
    Dim copyRange As Range
    Dim i As Long
    Dim startOfRowCell As Range
    Dim Cell As Range
    
    ' edit to the top left cell of the data area
    Set startRange = Worksheets(2).Range("A5")
    ' edit to the top left cell of the area where you want to copy the rows
    Set copyRange = Worksheets(1).Range("A5")
    ' variable for next empty row
    i = 0
    
    ' Loop over all rows
    For Each startOfRowCell In Worksheets(2).Range(startRange, startRange.End(xlDown))
    
        ' loop over all cells in row
        For Each Cell In Worksheets(2).Range(startOfRowCell, startOfRowCell.End(xlToRight))
    
            ' check for formatting
            If Cell.DisplayFormat.Interior.Color = vbRed Then
                ' copy whole row
                Cell.EntireRow.copy
                ' paste to second table (only values, not the formatting)
                copyRange.Offset(i, 0).PasteSpecial xlValues
                ' increment to paste next row beneath
                i = i + 1
                ' break the inner loop to check next row if "red" value is found
                Exit For
            End If
        
        Next Cell

Next startOfRowCell

End Sub

Answer 1

EDIT

For multiple columns of conditionally formatted cells I recommend a nested loop like this:

Sub copy_formatted()

' edit to the top left cell of the data area
startRange = Table1.Range("A1")
' edit to the top left cell of the area where you want to copy the rows
copyRange = Table2.Range("A1")
' variable for next empty row
i = 0

' Loop over all rows
For Each startOfRowCell In Table1.Range(startRange, startRange.End(xlDown))

    ' loop over all cells in row
    For Each cell in Table1.Range(startOfRowCell, startOfRowCell.End(xlToRight))

        ' check for formatting
        If cell.DisplayFormat.Interior.Color = vbRed Then
            ' copy whole row
            cell.EntireRow.copy
            ' paste to second table (only values, not the formatting)
            copyRange.Offset(i, 0).PasteSpecial xlValues
            ' increment to paste next row beneath
            i = i + 1
            ' break the inner loop to check next row if "red" value is found
            Exit For
        End If
    
    Next cell

Next startOfRowCell

End Sub

---

ORIGINAL

Since you did not provide the structure of your data I asumed something like this in the first sheet with the conditional formatting in the second column (in my case named Tabelle1 and starting in the top left of the sheet):

a   15  jan
b   53  feb
a   514 mrz
...

and a second empty sheet called Tabelle2.

Now you have to iterate over the cells with the relevant formating (in my case the second column) and simply copy the whole row to the second table like so:

Sub copy()

i = 0

' Loop over all cells in the respective column
For Each cell In Tabelle1.Range(Tabelle1.Cells(2, 2), Tabelle1.Cells(2, 2).End(xlDown))

    ' check for formatting
    If cell.DisplayFormat.Interior.Color = vbRed Then
        ' copy whole row
        cell.EntireRow.copy
        ' paste to second table starting in the top left (only values, not the formatting)
        Tabelle2.Cells(1, 1).Offset(i, 0).PasteSpecial xlValues
        ' increment to paste next row beneath
        i = i + 1
    End If
    
Next cell

End Sub

Answer 2

Conditional formatting might be a bit diferent color-wise than what you'd expect from it. Here's an example to show what I mean:

and here the code you can use to make this happen if you'd conditionally format 1 to 10 (conditional formatting, color-scaling red-yellow-green):

Sub test()
    Dim arr, lRow As Long, ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1) 'adjust this to your need
    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row 'check what the last used row is
    Dim i As Long
    ReDim arr(1 To lRow, 1 To 1) '
    For i = 1 To lRow
        arr(i, 1) = ws.Range("A" & i).DisplayFormat.Interior.Color 'check the color value
    Next i
    ws.Range("B1").Resize(lRow).Value = arr 'displaying what the color values are of a conditional formatted color-scaling
    ws.Range("A" & lRow).Offset(1).Interior.Color = vbRed 'now THIS is pod- ... this is vbRed
    With ws.Range("B" & lRow).Offset(1)
        .Value = .Offset(, -1).Interior.Color 'vbRed is way... way down to the values you'd normally get from conditional formatting
    End With
End Sub

So unless you're sure your conditional formatting is setting it to that value (also see this answer for more in-depth answering about the different values), it's better to have a different approach. Which red would you draw the line in my example even?
If you're setting it to that specific red however with a "$A2 > 50" or something similar, it'd be easier to just check if the value exceeds your limits.