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 Cb3dard,

You're going to have to upload a sample of your work book as the screen shot is near impossible to read. You can upload a sample using a free file sharing site such as DropBox (but be careful with any sensitive data).

In the meantime, have a fiddle with the following code which I just slapped together based on your description to see if its at least close to what you may need:-

Sub CopyData()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer

Sheets("Order List").UsedRange.Offset(2).ClearContents

For Each ws In Worksheets
    If ws.Name = "Order List" Then GoTo NextSheet
    
    ws.Select
    
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
For Each cell In Range("L2:M" & lRow)
        If cell.Interior.ColorIndex = 6 Then
            Range(Cells(cell.Row, "A"), Cells(cell.Row, lCol)).Copy
            Sheets("Order List").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
Next cell

For Each cell In Range("G2:G" & lRow)
        If cell.Interior.ColorIndex = 6 Then
            Range(Cells(cell.Row, "A"), Cells(cell.Row, lCol)).Copy
            Sheets("Order List").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
Next cell
NextSheet:
Next ws

Sheets("Order List").Range("A2:P" & Rows.Count).RemoveDuplicates Columns:=Array(7, 12, 13), Header:=xlYes
Sheets("Order List").Select

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

I've attached my test work book for you to peruse here:-

https://www.dropbox.com/s/3vmkwoy7hnlw5ma/Cb3dard.xlsm?dl=0

Let us know how it goes.

Cheerio,
vcoolio.

 

[cb3dard]

Thanks vcoolio for helping; it is very much appreciated!

I tried playing around with your code but couldn't make any progress. Unfortunately I only have pretty basic knowledge of VB. Your test workbook looks close to what I'm trying to accomplish, but when I click "update" I get the error "Cannot find project or library."

I've uploaded an example of the worksheet I'm using (with fictitious data) so I hope this helps. The sheet "Order List" is what I'd like to have populated from the data in the other sheets. The first sheet in the workbook is basically a listing of all the sheets and should be excluded if possible from the report generated in the order list.

https://www.dropbox.com/s/3u7r936f10fg1oh/test.xlsm?dl=0

Again, many thanks for the assistance with this.

 

[vcoolio]

Hello again Cb,


The link is not working. You may have to try again.

As for the error "Cannot find project or library", its not a code problem but more a settings problem. If you have recently updated from an older version of Excel (say 2003 or 2007) to 2010 or 2013 its possible that the application has lost the reference to an object or type library and hence won't run any code. Read the following article:-

https://support.microsoft.com/en-au/kb/208218

as it may help.

"The first sheet in the workbook is basically a listing of all the sheets and should be excluded if possible from the report generated in the order list."

Yes, can do but I'll wait to see your work book first.

Cheerio,
vcoolio.

 

[cb3dard]

Hi vcoolio,

Sorry about the link; I'm not sure why that happened. Hopefully this works:

https://www.dropbox.com/s/3u7r936f10fg1oh/test.xlsm?dl=0

In the meantime, I will take a look at the support article you provided and implement the fix.

Thanks again!

 

[vcoolio]

Hello Cb,

Thanks for that. I toyed with you work book and nothing happened! After some "choice" words, it dawned on me that, sadly, the Colour and ColourIndex properties of a Range don't return the colour of a cell if Conditional formatting is applied to the cell.

My dummy work book works fine because I've just used the standard fill colour index of 6 (yellow). Because you have Conditional Formatting colouring, Excel has decided to be stubborn and not recognise the colour in a macro. There is a work-around which can give us the CF colour code which can then be included in the macro but it is a very cumbersome and unnecessary method. Have a look at the following articles by a couple of Excel experts and you'll see why:-

Conditional Formatting Colors

Get Displayed Cell Color (whether from Conditional Formatting or not)

One way that we could get around the issue is to remove the CF and re-apply it with a macro which would then be recognised by the transfer macro above.
Another way would be to not have CF at all but in the transfer macro, have it based on the criteria of, say, the stock quantity (Column G) being less than or equal to X items and then having the row transferred to the Order List. You would need to select a critical point here for X (e.g. four items remaining).

Let me know your thoughts.

Cheerio,
vcoolio.

 

[cb3dard]

Good morning vcoolio,

Thanks once again for the help. I apologize that I didn't get back to you sooner; I was away for a little over a week.

I like your idea, but it sounds like it would be a lot of work for you.

What if we were to just pull ALL rows from every other sheet and dump them all into one sheet (calling it "all items"). This way I could just do away with the conditional formatting on all the other sheets, and instead just apply it to my "all items" sheet. This may be better anyway, because I'm finding that when people are copying and pasting within sheets, the conditional formatting is sometimes lost for the lines that were pasted. I could then lock the "all items" sheet so that it's only pulling info, and isn't directly editable. Does this make sense?

It would have to by dynamic, in the sense that if I added a rows to a sheet, they would also be added to the "all items" sheet and same when rows are deleted.

Let me know what you think and thanks again!

Chris

 

[vcoolio]

Hello Chris,

If you are happy to do it that way, then why not? Nothing quite like having complete control!

The following code should then do the task:-

Sub CopyAllTheData()

Application.ScreenUpdating = False

     Dim ws As Worksheet
     Dim lRow As Long
     Dim lCol As Integer

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

For Each ws In Worksheets
    If ws.Name = "All Items" Or ws.Name = "Set" Then GoTo NextSheet
    
    ws.Select
    
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
For Each cell In Range("A2:A" & lRow)
            Range(Cells(cell.Row, "A"), Cells(cell.Row, lCol)).Copy
            Sheets("All Items").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next cell

NextSheet:
Next ws

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

End Sub

Make a copy of your actual work book (just in case!), change the tab name "Order List" to "All Items" and copy/paste the above code into a standard module. The sheet named "Set" has also been excluded as per your post #3.
The code will basically refresh the "All Items" sheet every time you execute the code so hence will allow for any row increase/decrease.
You can password protect the "All Items" sheet the same as your other "booboo" code.

Let me know how it goes.

Cheerio,
vcoolio.

 

[vcoolio]

Hello Chris,

Further to my last post, we could trim the code down a little (just another option):-

Sub CopyAllTheData()

Application.ScreenUpdating = False

      Dim ws As Worksheet

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

For Each ws In Worksheets
       If ws.Name = "All Items" Or ws.Name = "Set" Then GoTo NextSheet
    
ws.Select
    
       ws.UsedRange.Offset(1).Copy
            Sheets("All Items").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

NextSheet:
Next ws

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

End Sub

Cheerio,
vcoolio.

 

[cb3dard]

Vcoolio,

This is excellent, thank you so much! It works like a charm.

I tested adding/deleting rows, modifying data, etc. and it all works beautifully.

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 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.

Thanks again!