Macro to copy rows from various sheets to the master sheet. Rows filtered by input on the master sheet.

[TonyG6470]

Hi All,

I've been searching various forums for days with an answer to my issue without success. I've found answers that partially work, but don't quite do what I want. I'm pulling my hair out and would appreciate any help.

I currently have a workbook which pulls in raw data from hundreds of text files and stores it on a raw data sheet. The text files contain a variety of message data all relating to successful and unsuccessful interactions. This data is then copied to various sheets in the workbook depending on the message type ie Message A to sheet Message A, Message B to B etc.

There are a few constants held within the messages and therefore across the worksheets. ie Message Reference and Booking Number.

What I want to do is on a new sheet called 'Message Analysis' enter a Message Reference ID or a Booking Number ID and then search specific sheets for matches. Where I get a match I want to copy in the Header row and list all matches beneath that header and then loop on to the next named sheet. The Message ID and the Booking Reference might be found multiple times on each sheet

So using this logic

Given I have a Message Reference in Cell B3 on Sheet 'Message Analysis'
And / Or a Booking Number in Cell C3 'Message Analysis'
When I search specific named worksheets
Then I want the header row copied of any worksheet with matches to the 'Message Analysis' sheet from Cell G2
And any matching rows to be copied beneath that header row
Then loop to the next named worksheet and continue searching

So end up with on the Message Analysis Sheet

Header Worksheet 1
Data
Data
Header Worksheet 2
Data
Header Worksheet 3
Data
Data
Data

Few other points

The worksheets contain calculated values and not absolute data
All headers have slightly different columns
I do not want to search every worksheet

Many thanks all

 

[TonyG6470]

Hi V

Hello Tony,

It would be extremely helpful and sensible if you could make the criteria column(s) uniform throughout your workbook.

I think I see what you're up to so we could try something as follows:-

Open the link below to a mock-up file I've created (and its really a mock-up!).
You'll see one destination sheet (Analysis) and four source sheets(A,B,C,D).
In cell C2, you'll see a data validation drop down list containing some mock criteria.
In cell C3, you'll see a data validation drop down list with the source sheet names.

The blue "RUN" button that you see has this code assigned to it:-

Option Explicit
Sub Test()
       
        Dim sh As Worksheet: Set sh = Sheets("Analysis")
        Dim Crit As String: Crit = sh.[C2].Value
        Dim wsSearch As String: wsSearch = sh.[C3].Value

Application.ScreenUpdating = False

        sh.[A5].CurrentRegion.Offset(1).Clear
       
        With Sheets(wsSearch).[A1].CurrentRegion
                .AutoFilter 5, Crit
                .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                .AutoFilter
        End With
       
                sh.Columns.AutoFit
       
Application.ScreenUpdating = True

End Sub

Select a criteria from the drop down in C2 and a sheet name from C3 in which you wish to search for the criteria.
When you click on the button, all the relevant rows of data from the selected worksheet will be transferred to the Analysis sheet.

Basically, all you need is one code as above.
A second criteria from another column could be added to the code if you wish.

Tony's Mock-Up File

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

Hello Tony,

Do you have another question?

Cheerio,
vcoolio.

 

[TonyG6470]

Hi VCoolio,

Yes, apologies. I got halfway through a reply and then realised what I was doing wrong. I couldn't work out why when I ran your code on my own workbook it was over writing the selection fields in C2, C3. Then I realised that I actually needed to enter the headings on my Message Analysis sheet. Once I'd one that the entries were copied as expected.

I've since added a second criteria and this is also working brilliantly, so many thanks for your advice. I've realised the importance of consistancy across the worksheets. Code now as follows:

Sub Test2()

Dim sh As Worksheet: Set sh = Sheets("Journey Detail")
Dim Crit As String: Crit = sh.[C2].Value
Dim Crit2 As String: Crit2 = sh.[D2].Value
Dim wsSearch As String: wsSearch = sh.[C3].Value

Application.ScreenUpdating = False

sh.[A5].CurrentRegion.Offset(1).Clear

With Sheets(wsSearch).[A1].CurrentRegion
.AutoFilter 7, Crit
.Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
.AutoFilter
End With


With Sheets(wsSearch).[A1].CurrentRegion
.AutoFilter 8, Crit2
.Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
.AutoFilter

End With
sh.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

There is one final piece missing for me. Rather than searching on individual sheets at a time ie value C3, I want to have the option to search a range of worksheets. This is because the searched value could appear on multiple sheets and have key information. I've spent a good deal of time reformatting all underlying searchable worksheets so that the headings are all identical. The sheet numbers are 3 to 23 and all have the word "Analysis" in their naming ie COP01 Analysis, COP02 Analysis etc. I've renamed my original search sheet to "Journey Details" to discount this from any search involving the string "Analysis".

Again, many thanks for your help so far. Enormously appreciated.

Kind regards,

Tony

 

[vcoolio]

Hello Tony,

Good work. Well done!

There is one final piece missing for me. Rather than searching on individual sheets at a time ie value C3, I want to have the option to search a range of worksheets. This is because the searched value could appear on multiple sheets and have key information. I've spent a good deal of time reformatting all underlying searchable worksheets so that the headings are all identical. The sheet numbers are 3 to 23 and all have the word "Analysis" in their naming ie COP01 Analysis, COP02 Analysis etc. I've renamed my original search sheet to "Journey Details" to discount this from any search involving the string "Analysis".

One code, searching through all source sheets, should do that for you. Based on what you have said, there are two worksheets that need to be excluded with the remaining (3 to 23) being the source sheets. Hence, based on that theory, this should do the task for you:-

Option Explicit
Sub Test()
        
        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Journey Details")
        Dim Crit1 As String: Crit1 = Sheet1.[C2].Value
        Dim Crit2 As String: Crit2 = Sheet1.[D2].Value
        
Application.ScreenUpdating = False

        sh.[A5].CurrentRegion.Offset(1).Clear
        
For Each ws In Worksheets
        If ws.Name <> "Journey Details" And ws.Name <> "Whatever" Then  '---->Change "Whatever" to suit.

                With ws.[A1].CurrentRegion
                        .AutoFilter 7, Crit1
                        .AutoFilter 8, Crit2
                        .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
         End If
Next ws
                sh.Columns.AutoFit
                
Application.ScreenUpdating = True

End Sub

It there are only two worksheets that are to be excluded, then this code will search all source sheets, regardless of number, and return the values for the specified criteria. You can use either one criteria or two in any order as you may only sometimes need Crit1 or Crit2 individually or you may need to search for a combination of both.

I've attached another mock-up for you to play with.

Another Mock-up

I hope that this helps.

Cheerio,
vcoolio.

 

[TonyG6470]

Hi Vcoolio,

Many thanks again for your help.

I've been playing around with your mock up and I don't think I communicated the requirements as well as I could.

In regards to the search itself I need it to work as follows:

Search all target worksheets with Crit1 and return all matches
Search all target worksheets with Crit2 and return all matches

At the moment what is happening is both values and used for the search and only return matches where both values match
ie

If I search using TX123 I return A10 and D3 - (Anything with just TX123)
If I search using Tony1 I return A11 and D1 - (Anything with just Tony1)
If I search using TX123 AND Tony1 I return A2, B5 & C1 - (Anything with BOTH TX123 AND Tony1)

What I would like is:

TX123 should match A10, D3, A2, B5 & C1 - (Anything with TX123 and BOTH TX123/Tony1)
If I search using Tony1 I return A11, D1, A2, B5 & C1 - (Anything with Tony1 and BOTH TX123/Tony1)
If I search using TX123 AND Tony1 A10, D3, A11, D1, A2, B5 & C1- (Anything with TX123, Tony1 and BOTH TX123/Tony1)

In regards the sheets to omit from the search, again, I don;t think I was clear enough. I have a number of sheets to omit. Apart from 'Journey Detail'. a;; the sheets to be omitted contain the word data ie Imported Data, Ref Data and then a long list of other sheets called COP01 Raw Data, COP02 Raw Data etc

I've had a go at amending your suggested code to include a 'like' clause as opposed to listing all the sheets out and it's not working unfortuanely:

Option Explicit
Sub Test()

Dim ws As Worksheet
Dim sh As Worksheet: Set sh = Sheets("Journey Detail")
Dim Crit1 As String: Crit1 = Sheet1.[D2].Value
Dim Crit2 As String: Crit2 = Sheet1.[D3].Value

Application.ScreenUpdating = False

sh.[A7].CurrentRegion.Offset(1).Clear

For Each ws In Worksheets
If Not ws.Name Like "*Data" And ws.Name <> "Journey Detail" Then '---->Change "Whatever" to suit.

With ws.[A1].CurrentRegion
.AutoFilter 7, Crit1
.AutoFilter 8, Crit2
.Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
.AutoFilter
End With
End If
Next ws
sh.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

Blowing up on this line:

.AutoFilter 7, Crit1

Which I think is because I do not have the required headers on all the sheets to be skipped? So I'm assuming my code to skip these sheets is incorrect.

Many thanks,

Tony

 

[vcoolio]

Hello Tony,

Ah huh! More like this then:-

Option Explicit
Sub Test()
        
        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Journey Details")
        Dim Crit1 As String: Crit1 = Sheet1.[C2].Value
        Dim Crit2 As String: Crit2 = Sheet1.[D2].Value
        Dim c As Range
        
Application.ScreenUpdating = False

        sh.[A5].CurrentRegion.Offset(1).Clear
        
For Each ws In Worksheets
        If ws.Name <> "Journey Details" And Right(ws.Name, 4) <> "Data" Then

                With ws.[A1].CurrentRegion
                        .AutoFilter 7, Crit1, xlAnd, "<>" & ""
                        .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                        .AutoFilter 8, Crit2, xlAnd, "<>" & ""
                        .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
         End If
Next ws
                sh.Columns.AutoFit
                
For Each c In sh.Range("F6", sh.Range("F" & sh.Rows.Count).End(xlUp))
        If Application.WorksheetFunction.CountIf(Columns(6), c.Value) > 1 Then
              c.EntireRow.Delete
        End If
Next c

Application.ScreenUpdating = True

End Sub

I've also included a few lines of code to remove duplicate values because with the way the criteria work in this case, there's potential for certain rows to be duplicated.
To test, if you remove these lines of code:-

For Each c In sh.Range("F6", sh.Range("F" & sh.Rows.Count).End(xlUp))
        If Application.WorksheetFunction.CountIf(Columns(6), c.Value) > 1 Then
              c.EntireRow.Delete
        End If
Next c

then use, say, TX123 as criteria 1 and Tony1 as criteria2, you may notice a couple of A2s, a couple of B5s and a couple of C1s returned as well. This may not be the case in your actual workbook but you never know so that's why I've added the extra lines of code.

I've attached another mock-up for you to test with. In this mock-up, I've also added a few more worksheets including the word "Data" in the sheet name and have covered their exclusion in the code above.

Take 3

I hope that this helps.

Cheerio,
vcoolio.

 

[TonyG6470]

Hi Vcoolio,

Many thanks again for your help and perseverance. Unfortunately I'm having an issue converting your solution into my spreadsheet.

I'm getting an error in regards to the Crit2 value. I've spent days trying to sort what's going on. Almost certainly something I've missed.

I've uploaded a sanitised copy of my spreadsheet for you to take a look at:

VCoolio1.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Please let me know if you can't access the link. First time I've used the WeTransfer service!

Cheers,

Tony

 

[vcoolio]

Hello Tony,

The code that you have placed in Module1 is this:-

Option Explicit
Sub Filter()
       
        Dim ws As Worksheet
        Dim sh As Worksheet: Set sh = Sheets("Journey Detail")
        Dim Crit1 As String: Crit1 = Sheet1.[D2].Value
        Dim Crit2 As String: Crit2 = Sheet1.[D3].Value
        Dim c As Range
       
Application.ScreenUpdating = False

        sh.[A7].CurrentRegion.Offset(1).Clear
       
For Each ws In Worksheets
        If ws.Name <> "Journey Detail" And Right(ws.Name, 21) <> "Data" Then

                With ws.[A1].CurrentRegion
                        .AutoFilter 7, Crit1, xlAnd, "<>" & ""
                        .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                        .AutoFilter 8, Crit2, xlAnd, "<>" & ""
                        .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
         End If
Next ws
                sh.Columns.AutoFit
       
Application.ScreenUpdating = True

End Sub

Theses two lines:-

Dim Crit1 As String: Crit1 = Sheet1.[D2].Value
Dim Crit2 As String: Crit2 = Sheet1.[D3].Value

should read as follows:-

Dim Crit1 As String: Crit1 = sh.[D2].Value
Dim Crit2 As String: Crit2 = sh.[D3].Value

with the variable sh having the value "Journey Detail". In the last code that I supplied to you, I had assumed that the worksheet "Journey Detail", your destination sheet, had the sheet code Sheet1. Alas, it did not and, based on your sample, the sheet code is Sheet46. Hence, the code was looking for the Crit1 and Crit2 values in the COP03 worksheet. Stay with the sh variable in this case.

For some reason, you have changed this line:-

If ws.Name <> "Journey Detail" And Right(ws.Name, 4) <> "Data" Then

to

If ws.Name <> "Journey Detail" And Right(ws.Name, 21) <> "Data" Then

which means that the right function is looking for a string with 21 characters. "Data" has only 4 characters. Hence change the line of code back to the way it was.

Make the adjustments as above and then see if it works for you.

Cheerio,
vcoolio.

 

[TonyG6470]

Hi Vcoolio,

Brilliant! Works beautifully. Thank you so much for your continuing help and patience.

I'm not sure what happened with the sh. v sheet1 anomaly. All I did was copy in your amendments. Apologies though for not noticing that error.

In regards to the 4 v 21, I'd assumed, incorrectly, that 4 related to the number of sheets after the Journey Detail sheet. Equally I thought, again incorrectly that "Data" explicitly meant and sheets named exactly as "Data" and couldn't see how the code was going to work....

Anyway, this has saved me a massive amount of pain and head scratching.

Thanks again!

Tony

 

[vcoolio]

Hello Tony,

No worries. You're welcome.

That was just me assuming that the destination sheet had the sheet code of Sheet1. Having your actual workbook sample made a big difference in sorting this out for you.

We had to get there sooner or later! I'm glad to have been able to assist.

Cheerio,
vcoolio.