PDA

View Full Version : Consolidating data from mutiple sheets by Date Column



LucasLondon
11-29-2006, 08:46 AM
Hello there,

I have several excel worksheets that I want to consolidate into one. In each sheet, column A contains a daily date field and column B contains the values associated for thoose dates.

But the length of each series is not the same, some series could start in 1998, others in 2004 and even when the periods covered overlap, not every date will have a value in all the sheets/for all the series.

I need to create a summary sheet of all this data grouped by date. So in the summary sheet, Column A would have the dates and then each successive column (B, C D E etc) would have the data values associated for that given date from respective sheets. Where a particular series does not have a value for a given date, I want that particular cell to be populated with the value ?-?or left blank.

So for example, say the individual sheets contain the following data:

Sheet 1

Col A Col B
11/11/2006 4
12/11/2006 5
13/11/2006 6

Sheet 2
Col A Col B
11/11/2006 19
13/11/2006 20


The summary sheet would collate all the data together as follows (assuming sheet 1's data goes into column b and sheet 2's data into col C:

Summary Sheet
Col A Col B COL C
11/11/2006 4 19
12/11/2006 5 -
13/11/2006 6 20


To help achieve this task, in the summary sheet I could create a date field covering every potential date that each series could have. Then I guess I would just need some kind of code or look up function that would bring in the data from the individual sheets aligned by date.

Any help much appreciated!

mdmackillop
11-29-2006, 02:00 PM
Hi Lucas
Give this a try. Set first sheet name as "Summary"
Regards
MD

Option Explicit
Sub Consolidate()
Dim tgt As Range, Source As Range, CkRange As Range, Cel As Range
Dim rw As Long, i As Long
For i = 2 To Sheets.Count
Set tgt = Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Sheets(i).Activate
Set Source = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 2)
rw = Source.Rows.Count
Source.Copy tgt
Set CkRange = tgt.Offset(, 1).Resize(rw)
For Each Cel In CkRange
If Len(Cel) = 0 Then Cel = "-"
Next
CkRange.Cut tgt.Offset(, i - 1)
Next
Sheets("Summary").Activate
End Sub

LucasLondon
11-30-2006, 05:25 AM
Thanks for the code MD.

It does partly what I need but not entirely. It consolidate the data in the sheet but duplicates the dates, however I need unique dates in the summary sheet.

For example, if both sheets contain the date, 12/11/2006, it enters this data twice in the summary sheet, with the corresponding value in different columns. However, I do not want the data stacked up like this by date; I just want unique dates in column A with the corresponding value for that date from the other sheets stored in adjacent columns.

Going back to my orginal example - like this:

Col A Col B COL C
11/11/2006 4 19
12/11/2006 5 -
13/11/2006 6 20

Rather than the way it's currently doing it:

Col A Col B COL C
11/11/2006 4
12/11/2006 5
13/11/2006 6
11/11/2006 19
12/11/2006 -
13/11/2006 20

Thanks,

Lucas

mdmackillop
11-30-2006, 02:55 PM
Option Explicit
Sub Consolidate()
Dim tgt As Range, Source As Range, CkRange As Range, Cel As Range
Dim Rw As Long, i As Long, Dt As Range
Dim c As Range
Application.ScreenUpdating = False
'Loop through each sheet after first
For i = 2 To Sheets.Count
'Find place to post result
Set tgt = Sheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Sheets(i).Activate
'Find data to copy and copy to target
Set Source = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 2)
Rw = Source.Rows.Count
Source.Copy tgt
'Insert - at any blank cells
Set CkRange = tgt.Offset(, 1).Resize(Rw)
For Each Cel In CkRange
If Len(Cel) = 0 Then Cel = "-"
Next
'Move data to corresponding column
CkRange.Cut tgt.Offset(, i - 1)
Next
Sheets("Summary").Activate

'Part 2
'Find end of copied data
Rw = Cells(Rows.Count, 1).End(xlUp).Row
Do
'Read last cell
Set Dt = Cells(Rw, 1)
'Find location if date occurred before
Set c = Range(Cells(1, 1), Cells(Rw - 1, 1)).Find(Dt, Cells(1, 1), xlFormulas)
'If found, move corresponding value to first found value
If Not c Is Nothing Then
Dt.End(xlToRight).Cut Cells(c.Row, Dt.End(xlToRight).Column)
Dt.EntireRow.Delete
End If
'Check next cell
Rw = Rw - 1
Loop Until Rw = 1
Application.ScreenUpdating = True
End Sub

LucasLondon
01-05-2007, 09:35 AM
Thanks mdmackillop, the code works great.

Was just wondering, How easy would it be to apply the code to WORKBOOKS instead of WORKSHEETS?

I’ve realised that I have an additional process at my end, which I don’t need. Let me explain. I have several workbooks, which I copy data from and paste into sheets in a single workbook and then I run the macro you devised to consolidate data from all the individual sheets into a summary worksheet. This works fine.

Instead of copying data from workbooks and pasting each series into individual sheets within my workbook and then running the macro, I would like to apply the macro directly to the workbooks and compile the series in a single sheet in a summary workbook.

Currently each workbook contains one series in the first sheet. Same set up as before, column a has dates, column b has values

What I want to do is have all the workbooks open, including a summary workbook which I will create (called summary!) and then I like to run a macro to copy the data from each workbook and align according to the date field in the summary workbook as before.

Effectively I already have the code to do the consolidation, but instead of pulling data from individual sheets in a single workbook, I want to pull the same data from multiple workbooks instead.

Would this be easy to do? I'm not sure adapt the code to do this.

Many Thanks,

Lucas

LucasLondon
01-24-2007, 01:58 PM
Hi,

It's been a few weeks since I posted my reply. Did anyone get a chance to have a look?

Thanks

Lucas