Fetch rows based on conditional formatting and display in new sheet

[cb3dard]

Hi everyone!

I'd like to automate excel so that it displays all records from other tabs where a certain condition is met (based on conditional formatting).

In my worksheet I have multiple sheets containing data that I'd like to pull from. These sheets are all formatted in the same way (i.e. column X means the same thing across all sheets).
An example of my source table is the following (used to track inventory).

I've set up conditional formatting for column G to highlight yellow when the warehouse quantity is less than minimum quantity, as well as when expiry dates from colums L or M are either expired or expiring in the next 90 days.

I have a final sheet which I want to auto-populate as my "order list", based on the higlighted cells in the other sheets (i.e. if a row contains a cell that is highlighted yellow, the entire row is added to the order list). Similarly, when inventory is updated in the source sheet and the cell is no longer yellow, the row should be removed from the order sheet.

I experimented with linking data but this becomes a problem when additional rows are added to the source sheets.

Thanks in advance for any help.

 

[vcoolio]

Hello Chris,

Can I ask for one little tweak? If I were to add a column in the "All Items" sheet called "Kit", would it be possible to have excel identify which sheet each item came from based on the item's sheet name? (e.g. all rows that were pulled from the sheet "Triage" would be identified as "Triage" in the "Kit" column).

I have two options for you:-

Sub TransferAllTheData()

Application.ScreenUpdating = False

Dim sh As Worksheet
Dim lRow As Integer

Sheets("All Items").UsedRange.Offset(1).ClearContents

For Each sh In Worksheets
    If sh.Name <> "All Items" And sh.Name <> "Set" Then
        Sheets(sh.Name).Select
        For Each cell In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If cell.Value <> "" Then
                lRow = Sheets("All Items").Range("A" & Rows.Count).End(xlUp).Row + 1
                 Range(Range("A" & cell.Row), Cells(cell.Row,  Columns.Count).End(xlToLeft)).Copy Sheets("All Items").Range("A" &  lRow)
                Sheets("All Items").Range("[COLOR=#ff0000]V[/COLOR]" & lRow).Value = sh.Name
            End If
        Next cell
    End If
Next sh

Sheets("All Items").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("All Items").Select

End Sub

This code does as you would like. It places the tab names in Column V in the "All Items" sheet. Change the column reference (the red "V" in the code above) to whichever column you choose.

Have a look at my test work book here:-

https://www.dropbox.com/s/a39yqkhyiy3k8dy/Cb3dard(2).xlsm?dl=0

Next option:-

Sub TransferAllTheData2()

Application.ScreenUpdating = False

Dim sh As Worksheet
Dim lRow As Integer

Sheets("All Items").UsedRange.Offset(1).ClearContents

For Each sh In Worksheets
    If sh.Name <> "All Items" And sh.Name <> "Set" Then
        Sheets(sh.Name).Select
                lRow = Sheets("All Items").Range("A" & Rows.Count).End(xlUp).Row + 1
                sh.UsedRange.Offset(1).Copy
                Sheets("All Items").Range("A" & lRow).PasteSpecial xlPasteValues
                Sheets("All Items").Range("V" & lRow).Value = sh.Name
                Sheets("All Items").Range("V" & lRow).Font.Bold = True
          End If
   Next sh

Sheets("All Items").Columns.AutoFit

Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("All Items").Select

End Sub

This code does the same but instead of having the tab names in every cell, it takes each tab name only once (a little like a summary heading) and lists the data from each sheet beside and below the tab name in the "All Items" sheet. Again, change the "V" column reference to your choice.
My preference is this second option as it creates less clutter.
Have a look at my test work book here:-

https://www.dropbox.com/s/gf729snrsxswc2w/Cb3dard(3).xlsm?dl=0

I also have one question: From what I can see, there is nothing in the code that would modify any of the source data. If I implement this in my real workbook and somewhere down the line I notice something wrong, the source data should all be intact, right? Worst case I would just have to re-generate an "All Items" list.

Correct! Plus I assume that you would back up on a daily basis.

Chris, again, test the codes on a copy of your actual work book.

I hope that this helps.

Cheerio,
vcoolio.

 

[cb3dard]

Thanks again vcoolio! This has been a great help.

I appreciate the suggestion with your second option, and while I like it better, my staff who maintain the database prefer the first option (i.e. the sheet name being inserted into column V) so I think I'll go with that. All the data transfers over correctly and updates accordingly as before when rows are deleted or added.

Two things are happening however that I'd like to try and fix:

1. The column widths of the "All items" sheet are changed everytime I run the macro. This is a problem because I have them set to a specific width for optimal printing. Can the data be inserted without changing the column width?

2. When the first row of every sheet is transferred over, it's picking up the formatting of the cell borders sporadically (see picture). Can the data be inserted without affecting the cell borders?

Thanks once again, and hopefully this is the last time I'll need your help!

 

[vcoolio]

Greetings Chris,

Lets see:-

1. The column widths of the "All items" sheet are changed every time I run the macro. This is a problem because I have them set to a specific width for optimal printing. Can the data be inserted without changing the column width?

Remove the following line of code:-

Sheets("All Items").Columns.AutoFit

2. When the first row of every sheet is transferred over, it's picking up the formatting of the cell borders sporadically (see picture). Can the data be inserted without affecting the cell borders?

Alter the code slightly as follows (the bits in blue):-

Sub TransferAllTheData()

Application.ScreenUpdating = False

Dim sh As Worksheet
Dim lRow As Integer

Sheets("All Items").UsedRange.Offset(1).ClearContents

For Each sh In Worksheets
    If sh.Name <> "All Items" And sh.Name <> "Set" Then
        Sheets(sh.Name).Select
        For Each cell In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If cell.Value <> "" Then
                lRow = Sheets("All Items").Range("A" & Rows.Count).End(xlUp).Row + 1
                 [COLOR=#0000ff]Range(Range("A" & cell.Row), Cells(cell.Row,  Columns.Count).End(xlToLeft)).Copy 
                 Sheets("All Items").Range("A" &  lRow).PasteSpecial xlPasteValues[/COLOR]
                Sheets("All Items").Range("[COLOR=#ff0000]V[/COLOR]" & lRow).Value = sh.Name
            End If
        Next cell
    End If
Next sh

[COLOR=#ff0000]Sheets("All Items").Columns.AutoFit[/COLOR]
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("All Items").Select

End Sub

......and of course, remember to remove the bit in red.

I think that should do the trick!

Good luck with it all.

Cheerio,
vcoolio.

 

[cb3dard]

Vcoolio,

This works great!

Thank you once again; this wouldn't have been possible without you, and you've made the jobs easier for many people.

 

[vcoolio]

Good day Chris,

You're welcome. I'm glad that I could help out.

Good luck with it all.

Cheerio,
vcoolio.

 

[okuncolienker]

Hi Vcoolio,

This thread seems helpful, and I am trying to solve a similar problem which is a little different. What I am trying to do is populate a new worksheet only with records based on certain values in a particular column on another sheet. As of now I have been able to populate the entire sheet without the condition to populate only the records that I want.

There is a column in the worksheet "Full View" named 'Update Status' that has the values No Change, Updated, New, Closed. I need to only select those records in my new worksheet that I am populating below with only those records that have values such as No Change, Updated, New in the 'Update Status' Column. Thanks for your help in advance!

Sub Scatterplot()

Dim headers() As Variant
Dim ws As Worksheet
Set ws = Worksheets("Scatterplot Excel Template")

'Clean Contents
ws.Cells.ClearContents
ws.Cells.Interior.ColorIndex = 0

Sheets("New Risk Template").Range("B3:B4").ClearContents

'Assign headers
headers = Array("Record ID", "ID", "Title", "Summary", "Primary Risk Type", "Secondary Risk Type", _
"Primary FLU/CF Impacted", "Severity Score", "Likelihood Score", "Structural Risk Factors")

With ws
'.Cells(1, 1).Value = "Risk Inventory Report Scatterplot Template"

For I = LBound(headers()) To UBound(headers())
.Cells(1, 1 + I).Value = headers(I)
Next I

Dim book1 As Worksheet
Dim lookFor As Range
Set book1 = Worksheets("Full View")
Set lookFor = book1.Range("B2:X1000")


Dim row_count As Integer
Dim col_count As Integer

'Find the last row and column number
Dim col_name As String
Dim record_id As String
Dim col_index As Integer
row_count = book1.Range("C" & Rows.Count).End(xlUp).Row


'Loop for input values
For I = 2 To row_count

ws.Cells(I, 1).Value = book1.Cells(I + 1, 2).Value
ws.Cells(I, 2).Value = Right(ws.Cells(I, 1).Value, 4)

For j = 3 To 10
On Error Resume Next
col_name = ws.Cells(1, j)
record_id = ws.Cells(I, 1)

col_index = Sheets("Full View").Cells(2, 1).EntireRow.Find(What:=col_name, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Column

ws.Cells(I, j).Value = Sheets("Full View").Cells(I + 1, col_index).Value
Next
Next