VBA: Populate Data from Multiple Worksheets

[quanweitkd]

Need help to create a macro to extract the following data (highlighted in green) from Multiple Worksheets onto the Summary sheet:

• Month of Report onto E1
• Date of Report onto E2
• Carpark ID on column D
• Carpark ID + Lane ID onto column E
• Percentages for Hourly, Season Parking and Total on column F, G, H respectively

Biggest problem I faced is different carparks have different number of entries and exits, hence the loop condition must be dynamic during the data extraction.

Please download the sample file from here: Excel VBA Questions

 

[bebo021999]

With current data in sample file, its not too difficult.
But, with your actual file:
1- Is there other date, like 26_May, 27_May, 1_Jun ?
2- If so, how they are arrangeed? all the way down in Carpark ID sheet, and all the way accross in summary?
3- If so, could you add more date?

 

[quanweitkd]

The summary report for client always only consists of 2 dates. The other date's is 3 days from the first date. So for my sample, 25 May (earlier date) there is one raw report and 28 may (later date) there is another separate excel file. It is always extracted from the wed and sat raw reports. The summary worksheet is manually created after the 2 raw reports are generated from the system.
The data from 28 May will be extracted onto column I to L on the Summary sheet.

Please refer to the raw report sample for the later date: Excel VBA Questions

 

[quanweitkd]

Hi it has been 4 days,

With current data in sample file, its not too difficult.
But, with your actual file:
1- Is there other date, like 26_May, 27_May, 1_Jun ?
2- If so, how they are arrangeed? all the way down in Carpark ID sheet, and all the way accross in summary?
3- If so, could you add more date?

Hi do you need more information on this? I would appreciate if there is some updates. Thank you.

 

[Alex Blakenburg]

What is the starting point ? Does it start with just a workbook with just 1 sheet being the summary sheet ?
What is on the Summary sheet to start with ? Are columns D & E prepopulated and caters for every possibility ?
Are the 2 Raw Workbooks open or do they need to be opened ?
I can't match any of the data in the summary sheet, what line & columns are being pulled from the Raw workbooks for the Summary ?

 

[quanweitkd]

What is the starting point ? Does it start with just a workbook with just 1 sheet being the summary sheet ?
What is on the Summary sheet to start with ? Are columns D & E prepopulated and caters for every possibility ?
Are the 2 Raw Workbooks open or do they need to be opened ?
I can't match any of the data in the summary sheet, what line & columns are being pulled from the Raw workbooks for the Summary ?

Starting point is a workbook with 300+ worksheets (unnamed). The summary sheet does not exist on the raw report, it needs to be post created using macro (where I need help).
The Summary Sheet is the final report for the client that contains all the required data (below) on one page.

• Month of Report onto E1
• Date of Report onto E2
• Carpark ID on column D
• Carpark ID + Lane ID onto column E
• Percentages for Hourly, Season Parking and Total on column F, G, H respectively

On the Summary Sheet, columns D & E are meant to be created by macro and they do cater for every possibility.

Yes, with my current VBA code, the two raw workbooks need to be opened in order for the code to work. But with your level of expertise, might not need to open them to extract data.

Matching of data from the raw worksheets to the Summary Sheet:
1) Sheet1 Cell D3 > Summary Cell D5
2) Sheet1 Cell D3&D5 > Summary Cell E5
3) Sheet1 Cell C12 > Summary Cell F5
4) Sheet1 Cell E12 >Summary Cell G5
5) Sheet1 Cell G12 > Summary Cell H5
6) Sheet1 Cell D25&D27 > Summary Cell E6
3) Sheet1 Cell C34 > Summary Cell F6
4) Sheet1 Cell E34 >Summary Cell G6
5) Sheet1 Cell G34 > Summary Cell H6

and so on...

Biggest problem is different worksheets have different number of carpark entries and exits. Example, Sheet1 has 4 sets of data whereas Sheet2 has 6 sets of data.
Hence I failed when trying to loop through the worksheets.

Thank you Alex for responding!

 

[Alex Blakenburg]

Biggest problem is different worksheets have different number of carpark entries and exits. Example, Sheet1 has 4 sets of data whereas Sheet2 has 6 sets of data.

This should point you in the right direction.

This won't be everything you need but I am not going to be up for writing the whole application.
You are not doing yourself any favours using merged cells though.

Sub SummariseData()
    ' Initial assumption that Car Park Order in Summary is the same order as they appear in the
    ' Sheets from left to right and within each sheet down the page
    Dim wbSumm As Workbook, wbDetail As Workbook
    Dim shtSumm As Worksheet, shtDetail As Worksheet
    Dim summRow As Long
    Dim fndHdg As String, HdgCell As Range, HdgFirstAddr As String, HdgRow As Long
    Application.ScreenUpdating = False
    
    fndHdg = "Car Park No:"
    Set wbSumm = ThisWorkbook
    Set wbDetail = wbSumm                               '<--- Initially assume Raw Sheets are in workbook with code
    
    Set shtSumm = wbSumm.Worksheets("Summary")          '<--- Assumes this sheet already exists in the workbook with code
    summRow = 5
    
    For Each shtDetail In wbDetail.Worksheets
        If shtDetail.Name <> "Summary" Then
            With shtDetail
                Set HdgCell = .Columns("A:C").Find(What:=fndHdg, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
            
                If Not HdgCell Is Nothing Then
                      HdgFirstAddr = HdgCell.Address
                
                    Do
                        HdgRow = HdgCell.Row
                        shtSumm.Range("D" & summRow).Value = .Range("D" & HdgRow).Value
                        shtSumm.Range("E" & summRow).Value = .Range("D" & HdgRow).Value & .Range("D" & HdgRow + 2).Value
                        shtSumm.Range("F" & summRow).Value = .Range("C" & HdgRow + 9).Value / 100
                        shtSumm.Range("G" & summRow).Value = .Range("E" & HdgRow + 9).Value / 100
                        summRow = summRow + 1
                        
                        Set HdgCell = .Columns("A:C").FindNext(After:=HdgCell)
                           
                        If HdgCell Is Nothing Then Exit Do
                 
                    Loop Until HdgCell.Address = HdgFirstAddr
                  End If
                 
             End With
        End If
    
    Next shtDetail

    Application.ScreenUpdating = True
End Sub

 

[quanweitkd]

Thank you Alex!

 

[Alex Blakenburg]

You are welcome. Glad I could help.

 

[quanweitkd]

This should point you in the right direction.

This won't be everything you need but I am not going to be up for writing the whole application.
You are not doing yourself any favours using merged cells though.

Sub SummariseData()
    ' Initial assumption that Car Park Order in Summary is the same order as they appear in the
    ' Sheets from left to right and within each sheet down the page
    Dim wbSumm As Workbook, wbDetail As Workbook
    Dim shtSumm As Worksheet, shtDetail As Worksheet
    Dim summRow As Long
    Dim fndHdg As String, HdgCell As Range, HdgFirstAddr As String, HdgRow As Long
    Application.ScreenUpdating = False
   
    fndHdg = "Car Park No:"
    Set wbSumm = ThisWorkbook
    Set wbDetail = wbSumm                               '<--- Initially assume Raw Sheets are in workbook with code
   
    Set shtSumm = wbSumm.Worksheets("Summary")          '<--- Assumes this sheet already exists in the workbook with code
    summRow = 5
   
    For Each shtDetail In wbDetail.Worksheets
        If shtDetail.Name <> "Summary" Then
            With shtDetail
                Set HdgCell = .Columns("A:C").Find(What:=fndHdg, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
           
                If Not HdgCell Is Nothing Then
                      HdgFirstAddr = HdgCell.Address
               
                    Do
                        HdgRow = HdgCell.Row
                        shtSumm.Range("D" & summRow).Value = .Range("D" & HdgRow).Value
                        shtSumm.Range("E" & summRow).Value = .Range("D" & HdgRow).Value & .Range("D" & HdgRow + 2).Value
                        shtSumm.Range("F" & summRow).Value = .Range("C" & HdgRow + 9).Value / 100
                        shtSumm.Range("G" & summRow).Value = .Range("E" & HdgRow + 9).Value / 100
                        summRow = summRow + 1
                       
                        Set HdgCell = .Columns("A:C").FindNext(After:=HdgCell)
                          
                        If HdgCell Is Nothing Then Exit Do
                
                    Loop Until HdgCell.Address = HdgFirstAddr
                  End If
                
             End With
        End If
   
    Next shtDetail

    Application.ScreenUpdating = True
End Sub

Hi Alex by the way, how do I make this macro work if the code is residing at my PERSONAL.xlsb instead?