Forum Discussion

qplsn9's avatar
qplsn9
Copper Contributor
Feb 02, 2024

Macro to copy and paste a range of data into a new sheet based on conditional formatting in another

 

I have this spreadsheet for our laboratory stock. Column U determines if an item needs reordered based on calculations on our quantity in stock and an ordering point determined by us. Basically, I want to copy and paste only the items (as well as quantities, units, etc.) to the sheet 3_Master PO Form but only if the cell in column U is red or yellow. I have about 700 lines of items that have this formatting and I want the macro to go through each one and copy and paste it over to the next sheet if it is red or yellow. How do I do this?

  • qplsn9 If you're conditional formatting rules are simply based on the cell value (ie: >0, Green; =0, Yellow; <0, Red), you could just use AutoFilter to filter the data by values less than or equal to 0, then copy and paste the results to the destination sheet. Alternatively, you could also filter by color; however, this would have to be done twice, as you can only filter by one color at a time.

     

    To answer your question directly, you can loop through the range of cells and use the DisplayFormat.Interior.Color property to get the fill color set by conditional formatting; however, you will need to know the specific color codes that were used (ie: RGB(255, 235, 156) = Yellow; RGB(255, 199, 206) = Light Red). Based on the single screenshot provided, which is a very limited representation of what your actual data range might look like, the following is to be used as an example only for how this might be achieved:

     

    Option Explicit
    
    Sub CopyRecordsByDisplayFormat()
    
    'Clear the previous output values
        Dim wsOutput As Worksheet
        Set wsOutput = ThisWorkbook.Sheets("3_Master PO Form")
        With wsOutput
            .Range("A1:U" & .Cells(.Rows.Count, 21).End(xlUp).Row).Offset(1).ClearContents
        End With
    
    'Copy applicable rows from the inventory sheet to the output sheet
        Dim ws As Worksheet, rg As Range, lastRow As Long, rowId As Long, i As Long
        Set ws = ThisWorkbook.Sheets("2_LAB Inventory Master List")
        lastRow = ws.Cells(ws.Rows.Count, 21).End(xlUp).Row
        Set rg = ws.Range("A1:U" & lastRow)
        rowId = 2
        For i = 2 To lastRow
            Select Case rg.Cells(i, 21).DisplayFormat.Interior.Color
            ' if Yellow Fill OR Light Red Fill
                Case RGB(255, 235, 156), RGB(255, 199, 206)
                    wsOutput.Cells(rowId, 1).Resize(, 21).Value = rg.Rows(i).Value
                    rowId = rowId + 1
            End Select
        Next i
    
    End Sub

     

    Note: please adjust the sheet names, range references, column numbers and/or color codes to meet your needs. You've stated the output sheet is "3_Master PO Form", but in the screenshot provided it appears to be named "3_Master PO Request". Also, it was unclear to me which columns actually contain data (ie: column A and B appear to be blank), and which columns were to be included in the final output.

  • djclements's avatar
    djclements
    Bronze Contributor

    qplsn9 If you're conditional formatting rules are simply based on the cell value (ie: >0, Green; =0, Yellow; <0, Red), you could just use AutoFilter to filter the data by values less than or equal to 0, then copy and paste the results to the destination sheet. Alternatively, you could also filter by color; however, this would have to be done twice, as you can only filter by one color at a time.

     

    To answer your question directly, you can loop through the range of cells and use the DisplayFormat.Interior.Color property to get the fill color set by conditional formatting; however, you will need to know the specific color codes that were used (ie: RGB(255, 235, 156) = Yellow; RGB(255, 199, 206) = Light Red). Based on the single screenshot provided, which is a very limited representation of what your actual data range might look like, the following is to be used as an example only for how this might be achieved:

     

    Option Explicit
    
    Sub CopyRecordsByDisplayFormat()
    
    'Clear the previous output values
        Dim wsOutput As Worksheet
        Set wsOutput = ThisWorkbook.Sheets("3_Master PO Form")
        With wsOutput
            .Range("A1:U" & .Cells(.Rows.Count, 21).End(xlUp).Row).Offset(1).ClearContents
        End With
    
    'Copy applicable rows from the inventory sheet to the output sheet
        Dim ws As Worksheet, rg As Range, lastRow As Long, rowId As Long, i As Long
        Set ws = ThisWorkbook.Sheets("2_LAB Inventory Master List")
        lastRow = ws.Cells(ws.Rows.Count, 21).End(xlUp).Row
        Set rg = ws.Range("A1:U" & lastRow)
        rowId = 2
        For i = 2 To lastRow
            Select Case rg.Cells(i, 21).DisplayFormat.Interior.Color
            ' if Yellow Fill OR Light Red Fill
                Case RGB(255, 235, 156), RGB(255, 199, 206)
                    wsOutput.Cells(rowId, 1).Resize(, 21).Value = rg.Rows(i).Value
                    rowId = rowId + 1
            End Select
        Next i
    
    End Sub

     

    Note: please adjust the sheet names, range references, column numbers and/or color codes to meet your needs. You've stated the output sheet is "3_Master PO Form", but in the screenshot provided it appears to be named "3_Master PO Request". Also, it was unclear to me which columns actually contain data (ie: column A and B appear to be blank), and which columns were to be included in the final output.

    • qplsn9's avatar
      qplsn9
      Copper Contributor
      This works, thank you! I fixed the errors in naming. How would I make it so that it transfers only columns A:F, N:O, and U to the 3_Master PO Request sheet without any blank columns in between?
      • djclements's avatar
        djclements
        Bronze Contributor

        qplsn9 To transfer the specified columns (9 in total) to columns A:I in the output worksheet, try the following modifications:

         

        Option Explicit
        
        Sub CopyRecordsByDisplayFormat()
        
        'Clear the previous output values
            Dim wsOutput As Worksheet
            Set wsOutput = ThisWorkbook.Sheets("3_Master PO Request")
            With wsOutput
                .Range("A1:I" & .Cells(.Rows.Count, 9).End(xlUp).Row).Offset(1).ClearContents
            End With
        
        'Copy applicable rows from the inventory sheet to the output sheet
            Dim ws As Worksheet, rg As Range, lastRow As Long, rowId As Long, i As Long
            Set ws = ThisWorkbook.Sheets("2_LAB Inventory Master List")
            lastRow = ws.Cells(ws.Rows.Count, 21).End(xlUp).Row
            Set rg = ws.Range("A1:U" & lastRow)
            rowId = 2
            For i = 2 To lastRow
                Select Case rg.Cells(i, 21).DisplayFormat.Interior.Color
                ' if Yellow Fill OR Light Red Fill
                    Case RGB(255, 235, 156), RGB(255, 199, 206)
                        With wsOutput
                        ' columns A:F = A:F
                            .Cells(rowId, 1).Resize(, 6).Value = rg.Cells(i, 1).Resize(, 6).Value
                        ' columns G:H = N:O
                            .Cells(rowId, 7).Resize(, 2).Value = rg.Cells(i, 14).Resize(, 2).Value
                        ' column I = U
                            .Cells(rowId, 9).Value = rg.Cells(i, 21).Value
                        End With
                        rowId = rowId + 1
                End Select
            Next i
        
        End Sub

Resources