I have a table with values based on monthly based and product in 1st column as shown below (Say "sheet1"). This table has conditional formatting applied to highlight cell colors red/yellow/green based on target. So, I want to take only specific month(current month- May) column and want VBA to check, if any cell in that column is Red, select that entire row and copy past it into another sheet for example "Sheet2" with headers.
Product = Target Feb Mar Apr May
Wood >= 5 10 10 10 10
wood >= 5 28 28 28 28
Tree >= 12 30 45 60 68
plastic >= 45 50 50 50 50
tree >= 50 50 50 50 50
iron >= 100 64 75 75 80
The values will change monthly and even sometimes target, so the coloring can be totally green/yellow/red sometimes. So, I want to automate this process using VBA, to go and check on "Sheet1" every month and pull any rows which has red cell highlighted for that month. OR even a button function could also help, so I can assign this macro to a button, this action should be done by clicking the button. Even it should also clear all rows from earlier month in Sheet2, which might have highlighted in last month but not in this month.
I tried, different ways to do this, its not recognizing the cell color. When I use the random/regular cell out of table and fill with red color and use find(ctrl+f) popup box to highlight using color format, it is working but its not taking the cells which has conditional formatting in a table. So, I don't know if there is a way to identify all the cells in the table which is highlighted in red using VBA.
INPUT (IN WORKSHEET1):
OUTPUT (IN WORKSHEET2):
Sub newnew()
declaring the worksheets, Sheet2 and Sheet3 should be changed to match your sheet names
Dim ws As Worksheet
Set ws = Sheets("Sheet2")
Dim wsTwo As Worksheet
Set wsTwo = Sheets("Sheet3")
clearing out previous data in wsTwo
wsTwo.Cells.Clear
finding the last row and column for ws with data inside
Dim lastRow As Integer
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim lastColumn As Integer
lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
we are setting up the header here
ws.Range("A1:F1").Copy
wsTwo.Range("A1:F1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
beginning our loop from the last row and moving upwards till we hit row 2. We are checking if rowNum and lastColumn display format interior color is red. If it is we are taking that range, copying it, then pasting it in wsTwo. Note that we have that rowCounter which we set before entering the for loop. we will use that as a placeholder, incrementing every time that we paste in ws two, so that we don't paste over data we just pasted.
Dim rowCounterWsTwo As Integer
rowCounterWsTwo = 2
For rowNum = lastRow To 2 Step -1
If Cells(rowNum, lastColumn).DisplayFormat.Interior.Color = vbRed = vbRed Then
ws.Range(Cells(rowNum, 1), Cells(rowNum, lastColumn)).Copy
wsTwo.Range("A2:F2").Insert
Application.CutCopyMode = False
rowCounterWsTwo = rowCounterWsTwo + 1
End If
Next rowNum
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.