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

 

[vcoolio]

Hello Tony,

It would be easier for someone to help you if you supplied a sample of your workbook. Create an exact dummy of your workbook and use dummy data should your data be sensitive. Upload your sample to a free file sharing site (such as Drop Box or WeTransfer) then post the link to your file back here. We don't need masses of data just a few rows to work with per sheet.

I do not want to search every worksheet

Besides the Message Analysis sheet, please let us know which other worksheets need to be excluded.

Cheerio,
vcoolio

 

[TonyG6470]

Hi Vcoolio,

Many thanks for your reply. In regards to the worksheets to be excluded, that is dynamic and changing. As new messages are introduced there will be different worksheets. Some I will need to exclude and some I won't. Hence I just want to search named worksheets. That said they all sheets to be excluded contain the word 'Data'. If I keep that naming convention going forward I guess it's possible to write the code to exclude all workbooks containing the word 'Data'. I could even extend that to change the 'Message Analysis' to sheet 'Message Data Analysis'.
In regards to uploading a workbook, I will look at doing that, though as you intimate it does contain sensitive data which will require a good deal of work to mask.

Cheers,

Tony

 

[vcoolio]

Hello Tony,

We don't need your complete workbook. Just create an exact mock-up with a few sheets named however you need them named plus a named destination sheet. As for the actual data, just make up anything such as Data1, Data2, Data3 etc......
Just a few rows per sheet will do and show the inputs and the expected result in the destination sheet. As long as your mock-up is an exact replica in regards the set out of your actual workbook, we should be able to help you fairly quickly.

Cheerio,
vcoolio.

 

[TonyG6470]

Hi VCoolio,

Rather than ask for help with the whole coding, I've been having a go myself and come up with the following:

Sub AutoFilter_RangeCopy_Row()

' Get the worksheets
Dim shRead As Worksheet, shWrite As Worksheet
Set shRead = ThisWorkbook.Worksheets("COP01 Analysis")
Set shWrite = ThisWorkbook.Worksheets("Message Analysis")

With shWrite
' Clear the data in output worksheet
.Cells.ClearContents

' Set the cell formats
'.Columns(2).NumberFormat = "dd/mm/yyyy"
'.Columns(3).NumberFormat = "$#,##0;[Red]$#,##0"
'.Columns(4).NumberFormat = "0"
'.Columns(5).NumberFormat = "$#,##0;[Red]$#,##0"

End With

' Get the range
Dim rg As Range
Set rg = shRead.Range("A1").CurrentRegion

' Remove any existing filters
rg.AutoFilter

' Apply the Autofilter
rg.AutoFilter Field:=6, Criteria1:="TL00515477"

' Copy the data using Range Copy
shRead.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
shWrite.Range("E2").PasteSpecial xlPasteValues

' Active the output sheet so it is visible
shWrite.Activate

' Get the worksheets

Set shRead = ThisWorkbook.Worksheets("COP02 Analysis")
Set shWrite = ThisWorkbook.Worksheets("Message Analysis")


' Get the range
Set rg = shRead.Range("A1").CurrentRegion

rg.AutoFilter Field:=6, Criteria1:="TL00515035"
shRead.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
shWrite.Range("E2").PasteSpecial xlPasteValues

rg.AutoFilter
shWrite.Activate

End Sub

The formatting stuff is commented out as I intend to use that once I have the copy working.
Currently I have a couple of issues:

First the copy from the Second worksheet (COP02 Analysis) copies over the the data returned from the first worksheet (COP01 Analysis). I want this and any subsequent worksheets to find the next blank row in the Message Analysis sheet and continue writing from there.

Second rather than explicitly stating the string to be searched for ie TL00515035 I want to use a cell Ref on the Message analysis spreadsheet ie whatever is in cell B3 is used as the search string. It would also be nice to search on cell B4 and return those matches too.
So take both string values in Cells B3 & B4, search COP01 Analysis, return all matches, search COP02 Analysis return all values etc

Many thanks,

Tony

 

[vcoolio]

Hello Tony,

Well done! You've worked hard on this one.
As for those couple of issues you wish to tidy up:-

Here's your code just trimmed a little for the "COP01" Analysis" sheet with some notes:

Option Explicit

Sub AutoFilter_RangeCopy_Row()

    Dim shRead As Worksheet, shWrite As Worksheet
    Set shRead = Worksheets("COP01 Analysis")
    Set shWrite = Worksheets("Message Analysis")
        
Application.ScreenUpdating = False

    shWrite.Cells.Clear

    'Dim rg As Range 'No need to declare a variable in this case. Its covered in the 'With' statement
    'Set rg = shRead.Range("A1").CurrentRegion
        
    With shRead.[A1].CurrentRegion    '----> This could also be: With shRead.Range("A1").CurrentRegion or With shRead.Cells(1).CurrentRegion
            .AutoFilter Field:=6, Criteria1:="TL00515477"
            .CurrentRegion.Copy
            shWrite.Range("E2").PasteSpecial xlValues
            .AutoFilter
    End With
    
'Next bit...........
     
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Add this line:-

shWrite.Range("E" & Rows.Count).End(3)(2).PasteSpecial xlValues

to the subsequent code instead of

shWrite.Range("E2").PasteSpecial xlValues

then data will be pasted to the next available row in shWrite so you won't have data overwritten.

With the second issue, if you want to search both source sheets at once for values in B3 and B4, we'd need to go back to what I said earlier about sheets to be excluded and hence only search the sheets that are required but I suppose another method would be to have say B5 as a cell used for a sheet search in addition to the two criteria cells.
You could have the criteria in B3, B4 and B5 as data validation drop down selections to save you typing in each different criteria as needed.

I hope that this helps.

Cheerio,
vcoolio.

 

[TonyG6470]

Hi Vcoolio,

Many thanks for taking the time to reply. I've incorporated your suggested changes re the overwriting, but unfortunately I still see results from COP01 Analysis over written by results from COP03 Analysis. I may have misinterpreted your instructions, so for reference here is my amended code:


Option Explicit

Sub AutoFilter_RangeCopy_Row()

Dim shRead As Worksheet, shWrite As Worksheet
Set shRead = Worksheets("COP01 Analysis")
Set shWrite = Worksheets("Message Analysis")

Application.ScreenUpdating = False

shWrite.Cells.Clear

With shRead.[A1].CurrentRegion
.AutoFilter Field:=6, Criteria1:="TL00515477"
.CurrentRegion.Copy
shWrite.Range("E2").PasteSpecial xlValues
.AutoFilter
End With

Set shRead = Worksheets("COP03 Analysis")
Set shWrite = Worksheets("Message Analysis")

Application.CutCopyMode = False
Application.ScreenUpdating = True


With shRead.[A1].CurrentRegion
.AutoFilter Field:=5, Criteria1:="TL00515654"
.CurrentRegion.Copy
shWrite.Range("E" & Rows.Count).End(3)(2).PasteSpecial xlValues
.AutoFilter
End With


Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

In regards to the sheets to be excluded from the search, any sheet with the word 'Data' ie 'COP01 Raw Data' needs to be excluded.

Many thanks,

Tony

 

[vcoolio]

Hi Tony,

I've noticed that you have differing criteria fields. Will each source sheet have a different criteria field? If so, can they be made uniform across all source sheets?

Cheerio,
vcoolio.

 

[TonyG6470]

Hi VCoolio,

Yes, good spot! That won't be an issue. Just a question of shifting the underlying columns around. I've moved the relevant column for the TL refs to "G", making this criteria correct:

.AutoFilter Field:=7, Criteria1:="TL00515654"

Of course if I do use the 2nd lookup value that I intimated earlier on I'd have to also select another field ie

.AutoFilter Field:=8, Criteria2:="200623164908" (not sure about the Criteria2 given my search could return either, none or both matches).

TL is a booking ref 2006etc is a message ref. Neither are unique and there could be multiple instances of both on either sheet.

Sorry, this is becoming more and more difficult as I realise potential pitfalls...

Cheers,

Tony

 

[vcoolio]

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.