Macro to extract data from multiple worksheets

[egulphy]

I'm in over my head here!

I have a spreadsheet containing a factory's operational data, with each machine in the factory being represented by its own worksheet.
The sheets all have the same structure, with each line of data representing a shift (we have 12-hour continental shifts, so column A of all the pages has the date in an standard format, and column B has either "d" or "n", representing the shift). Various datat is documented on each machine on a shift-per-shift basis.

What I need to do is figure out how to do a macro that extracts all of the lines on all of the machines' worksheets that pertain to a particular shift (for instance, all of the lines where column A read "14-Mar" and column B read "d"), and export the values of the entire row to another worksheet, creating a shift summary on one page.

To do this, I would like to make the date and shift user-definable variables that appear at the top of what would become the summary sheet, and have a button that activated such a macro at the top of the page as well.

 

[phantom1975]

WELCOME TO THE BOARD!

Let's say that cell A1 on a worksheet named "Summary" has the date you wish to filter and that B1 has the shift. Let's also assume that the date can be found in column A of each worksheet and the shift is in Column B of each worksheet. Here's the macro you can use on a CommandButton:

Private Sub CommandButton1_Click()
Dim WkSht As Worksheet
Dim r As Integer
    For Each WkSht In ThisWorkbook.Worksheets
        If WkSht.Name <> "Summary" Then
            For r = 1 To 1000
            'This will check the first 1000 rows of each sheet
                If WkSht.Range("A" & r).Value = Sheets("Summary").Range("A1").Value _
                        And WkSht.Range("B" & r).Value = Sheets("Summary").Range("B1").Value Then
                    WkSht.Rows(r & ":" & r).Copy Sheets("Summary").Range("A65536").End(xlUp).Offset(1)
                    Exit For
                    End If
                Next r
            End If
        Next WkSht
End Sub

 

[egulphy]

Thanks for getting me on the right track!

Since the date field is actually in cell B1 and d/n is in cell G1 on a sheet named "SUMMARY", I have made the following modifications:

Sub Summary()
Dim WkSht As Worksheet
Dim r As Integer
For Each WkSht In ThisWorkbook.Worksheets
If WkSht.Name <> "DAILY" Then
For r = 1 To 1000
'This will check the first 1000 rows of each sheet
If WkSht.Range("A" & r).Value = Sheets("DAILY").Range("B1").Value _
And WkSht.Range("B" & r).Value = Sheets("DAILY").Range("G1").Value Then
WkSht.Rows(r & ":" & r).Copy Sheets("DAILY").Range("A65536").End(xlUp).Offset(1)
Exit For
End If
Next r
End If
Next WkSht
End Sub

I'm almost there - but there's another curve ball.

The lines that meet the date criteria show up just like they should.

However, I need to change two things:

1) Some of the values copied to the summary sheet are actually calculated formulas, and in the new locations, they don't display correctly. I need to paste the VALUES of the cells into the new sheet.

2) Each worksheet that had data pulled from it is named after the machine it. On the "machine1" tab, there is no need to report which machine is being referenced, but when the data is moved to a summary page, the machine in question is not listed. Is there an easy way to have the extracted data moved over one column and have the first column in each row report the worksheet the data came from (or should I just cheat and create a dummy column that repeats the machine's name on each machine's page, then make it visible on the summary page?).

 

[phantom1975]

This should do the trick:

Private Sub CommandButton1_Click()
Dim WkSht As Worksheet
Dim r As Integer
    For Each WkSht In ThisWorkbook.Worksheets
        If WkSht.Name <> "Summary" Then
            For r = 1 To 1000
            'This will check the first 1000 rows of each sheet
                If WkSht.Range("A" & r).Value = Sheets("Summary").Range("A1").Value _
                        And WkSht.Range("B" & r).Value = Sheets("Summary").Range("B1").Value Then
                    WkSht.Rows(r & ":" & r).Copy
                    Sheets("Summary").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                    Sheets("Summary").Range("D" & Sheets("Summary").Range("A65536").End(xlUp).Row).Value = WkSht.Name
                    'Puts the machine name in column D
                    Exit For
                    End If
                Next r
            End If
        Next WkSht
End Sub

 

[egulphy]

Here's what I have:

Sub Summary()
Dim WkSht As Worksheet
Dim r As Integer
For Each WkSht In ThisWorkbook.Worksheets
If WkSht.Name <> "DAILY" Then
For r = 1 To 1000
'This will check the first 1000 rows of each sheet
If WkSht.Range("B" & r).Value = Sheets("DAILY").Range("B1").Value _
And WkSht.Range("C" & r).Value = Sheets("DAILY").Range("G1").Value Then
WkSht.Rows(r & ":" & r).Copy
Sheets("DAILY").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("DAILY").Range("A" & Sheets("DAILY").Range("A65536").End(xlUp).Row).Value = WkSht.Name
'Puts the machine name in column A
Exit For
End If
Next r
End If
Next WkSht
End Sub

The macro is copying the values, and even the worksheet title! However, it doesn't advance to the next line - it writes the data from the workbooks onto the same row.

The first row of the DAILY page has a macro button, and the second contains the headers, so I'm trying to get the data copied to rows starting with row 3, with the worksheet name of the first machine in A3, and the rest of the data on the line beside it.

Currently, when copying the worksheet name, it copies it into A2 (overwriting the heading with each extracted title).

 

[phantom1975]

Flip flop these two lines:


Sheets("DAILY").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("DAILY").Range("A" & Sheets("DAILY").Range("A65536").End(xlUp).Row).Value = WkSht.Name

 

[egulphy]

So far so good...

Here's the almost-functional version of the code:

Sub Summary()
Dim WkSht As Worksheet
Dim r As Integer
For Each WkSht In ThisWorkbook.Worksheets
If WkSht.Name <> "DAILY" Then
For r = 1 To 1000
'This will check the first 1000 rows of each sheet
If WkSht.Range("A" & r).Value = Sheets("DAILY").Range("B1").Value _
And WkSht.Range("B" & r).Value = Sheets("DAILY").Range("F1").Value Then
WkSht.Rows(r & ":" & r).Copy
Sheets("DAILY").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Sheets("DAILY").Range("B" & Sheets("DAILY").Range("A65536").End(xlUp).Row).Value = WkSht.Name
'Puts the machine name in column B
Exit For
End If
Next r
End If
Next WkSht
End Sub

How do I get it to check each sheet for multiple rows meeting the day and shift criteria? In some cases, these machines will run multiple jobs in one shift and have multiple entries on the same page. This macro copies what I need, but only grabs the FIRST of multiple entries.

 

[phantom1975]

Remove the Exit For command in your macro.

 

[egulphy]

Thank you so much!!! It works perfectly now!
If I'm ever in Arizona, I owe you a beer!

 

[aroramon]

Hello!

I'm having a similar problem but I'm a VBA newbie, so can't figure out how to modify the code you've provided to meet my needs

I have multiple SINGLE worksheet CSV documents that hold data that I need to extract and place into another formatted worksheet. All of the tabs in those documents have names that begin with "HOL-" followed by a series of random numbers and letters.

I need to pull about 10 values sitting in the second row of static columns from the CSV documents and place them in their "matching" spots in the formatted final worksheet. e.g. the value for "address1" on the CSV which sits in cell J2 (it always will), should be placed in the "address1" column in the final formatted document. I would want the relevant fields from each CSV document to be pulled into it's own row in the final formatted document.

Any thoughts? Would it be necessary to pull the single CSV worksheets into one document? Would it be possible to build a macro for that as well?

Any help would be SOOOO appreciated!!

Many thanks in advance!