Extract and summarize from 100 worksheets into one

**HMIExcel08** · 06-18-2008, 01:16 PM

Hi All,

Please see attached Excel sample file. I would like to extract information with the event “Date” happens in June(6/1/08-6/30/08) in Column B on each worksheet. And I would like these data to be summarized from all different worksheets into one. Is there any code I can use so that I can drag these information out into a single worksheet at one time instead of keep looking in each worksheet (about 100) doing copy and paste?

Please be advised.

I appreciate for all your time and help!

Amy

**Trebor76** · 06-19-2008, 01:18 AM

Hi Amy,

Using the code from this posting by Dave Hawley as well as some of my own code (including some smarts), the following macro should do the trick:

Sub ConsDataByMonth()

    If MsgBox("Please click ""Yes"" if the data is to be consolidated on the " _
              & ActiveSheet.Name & " tab.", _
              vbYesNo + vbExclamation, "Data Consolidation Editor") = vbNo Then
        MsgBox "Select the tab you wish to have the data consolidated on and try again." _
            , vbInformation, "Data Consolidation Editor"
    Exit Sub
    End If

Application.ScreenUpdating = False

Dim lngLastRow As Long
Dim wSheet As Worksheet
Dim rCopy, rPaste As Range
Dim strMonth As String
    
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    If lngLastRow > 1 Then
        ActiveSheet.Range("A2:E" & lngLastRow).ClearContents
    End If
     
    For Each wSheet In Worksheets
        If wSheet.Name <> ActiveSheet.Name Then
            With wSheet
                Set rCopy = .Range("A2", .Cells(Rows.Count, 5).End(xlUp))
            End With
            Set rPaste = ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2, 1)
            rCopy.Copy
            rPaste.PasteSpecial Paste:=xlValues, Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End If
    Next wSheet

strMonth = "6" 'Calendar month (i.e. June in this case) filter - _
               change as required.  See code line noted below.

With ActiveSheet
    .Columns("B").NumberFormat = "m/d/yy"
    .Columns("D:E").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("F2").Formula = "=MONTH(B2)"
    .Range("F2").Copy .Range("F3:F" & lngLastRow)
    .AutoFilterMode = False
    .Columns("F").AutoFilter Field:=1, Criteria1:="<>" & strMonth 'Month filter
    .Rows("1").EntireRow.Hidden = True
    .Columns("F").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
    .Rows("1").EntireRow.Hidden = False
    .Columns("F").Delete
    .Columns("A:E").AutoFit
End With

Application.ScreenUpdating = True

ActiveSheet.Range("A1").Select

Select Case (strMonth)
    Case "1"
        MsgBox "January's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "2"
        MsgBox "February's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "3"
        MsgBox "March's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "4"
        MsgBox "April's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "5"
        MsgBox "May's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "6"
        MsgBox "June's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "7"
        MsgBox "July's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "8"
        MsgBox "August's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "9"
        MsgBox "September's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "10"
        MsgBox "October's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "11"
        MsgBox "November's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "12"
        MsgBox "December's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case Else
        MsgBox "The ""strMonth"" variable has not been set correctly." & _
        " Reset it with a string value of 1 to 12 (inclusive) and try again." _
            , vbCritical, "Data Consolidation Editor"
    End Select
    
End Sub

HTH

Robert

**HMIExcel08** · 06-19-2008, 12:31 PM

Dear Robert,

That seems to be a miracle to me! I tested the code on the original file i attached and it works beautifully, and of course, smartly!

My last question is, what if there are other columns in between Column D & E, which I noticed your put:
.Columns("D:E").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

In cases where I have other columns containing Currency, test and date and even some null values where are pending for data entry...etc., do I need to list each different column format separetely based on yours? If so, would you please give me a hint how could I accomplish such code?

I attached a new file which I added some new columns.

Thanks for all your time a help again!

Amy

**Trebor76** · 06-19-2008, 07:17 PM

Hi Amy,

Thanks for the feedback and I'm glad it worked (almost).

I've amended the following to meet the new layout - if you need to do this in the future, the area to adjust is within the

With ActiveSheet

to

End With

block. You can use the recorder the help with the code.

HTH

Robert

Sub ConsDataByMonth()

    If MsgBox("Please click ""Yes"" if the data is to be consolidated on the " _
              & ActiveSheet.Name & " tab.", _
              vbYesNo + vbExclamation, "Data Consolidation Editor") = vbNo Then
        MsgBox "Select the tab you wish to have the data consolidated on and try again." _
            , vbInformation, "Data Consolidation Editor"
    Exit Sub
    End If

Application.ScreenUpdating = False

Dim lngLastRow As Long
Dim wSheet As Worksheet
Dim rCopy, rPaste As Range
Dim strMonth As String
    
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    If lngLastRow > 1 Then
        ActiveSheet.Range("A2:E" & lngLastRow).ClearContents
    End If
     
    For Each wSheet In Worksheets
        If wSheet.Name <> ActiveSheet.Name Then
            With wSheet
                Set rCopy = .Range("A2", .Cells(Rows.Count, 8).End(xlUp))
            End With
            Set rPaste = ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2, 1)
            rCopy.Copy
            rPaste.PasteSpecial Paste:=xlValues, Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End If
    Next wSheet

strMonth = "6" 'Calendar month (i.e. June in this case) filter - _
               change as required.  See code line noted below.

With ActiveSheet
    .Range("B:B,E:E").NumberFormat = "m/d/yy"
    .Range("D:D,F:F,H:H").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("I2").Formula = "=MONTH(B2)"
    .Range("I2").Copy .Range("I3:I" & lngLastRow)
    .AutoFilterMode = False
    .Columns("I").AutoFilter Field:=1, Criteria1:="<>" & strMonth 'Month filter
    .Rows("1").EntireRow.Hidden = True
    .Columns("I").SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
    .Rows("1").EntireRow.Hidden = False
    .Columns("I").Delete
    .Columns("A:H").AutoFit
End With

Application.ScreenUpdating = True

ActiveSheet.Range("A1").Select

Select Case (strMonth)
    Case "1"
        MsgBox "January's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "2"
        MsgBox "February's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "3"
        MsgBox "March's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "4"
        MsgBox "April's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "5"
        MsgBox "May's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "6"
        MsgBox "June's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "7"
        MsgBox "July's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "8"
        MsgBox "August's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "9"
        MsgBox "September's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "10"
        MsgBox "October's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "11"
        MsgBox "November's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case "12"
        MsgBox "December's data has now been consolidated." _
            , vbInformation, "Data Consolidation Editor"
    Case Else
        MsgBox "The ""strMonth"" variable has not been set correctly." & _
        " Reset it with a string value of 1 to 12 (inclusive) and try again." _
            , vbCritical, "Data Consolidation Editor"
    End Select
    
End Sub

**HMIExcel08** · 06-19-2008, 11:07 PM

Hi Robert,

This is awesome! I tested it and this is exactly I want! I can't express how much I should appreciate for your code coz it's gonna save tons of my OT work for the following week.

Thanks again and have a wonderful weekend!

Amy