Forum Discussion
qplsn9
Feb 02, 2024Copper Contributor
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.
- djclementsBronze 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.
- qplsn9Copper ContributorThis 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?
- djclementsBronze 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