Consolidating datasets from Excel workbook using common feild
 

Hi,

I have three datasets in different excel workbooks which I need to
consolidate into one summary sheet but the three data block from each
sheet needs to be aligned by a common field in the three workbooks:
Column A which has dates for each block.

The set up of the different workbooks is as follows:

In each of the three workbooks, Column A has dates and row 1 as the name
of the indicators.

In the first workbook, the data starts in row 4 and column G and ends in
row 8632 (but this changes from week to week) and column AX.

In the second workbook, the data starts in row 2 and column B and ends
in row 5411 (changes week to week) and column AA.

In the third workbook, the data starts in row 2 and column B and ends in
row 6044 (changes week to week) and column E.

Is there a quick way to consolidate all the data by the date field into
a summary sheet from the three worksheets/books?

For example the summary sheet could look like this:

Column A = All possible dates contained in column A of the three files.
Columns G to AX would have data from the firstwook book aligned by the
date field. Columns AY to BX would have the data from the second
workbook aligned by date and BY to CB could contain the data from the
third file.

Would using vlookup or some kind of match function work to achieve this?
I'm seeking a VBA solution as in the past I've found having lots
functions in worksheets really slows down working with them.

Hope someone can help.

Thanks,

Lucas


*** Sent via Developersdex http://www.developersdex.com ***

Consolidating datasets from Excel workbook using common feild
 

The following code will open 3 workbooks and put the combined data in the
workbook where the macro is located (4th workbook). The code copies book 1
without any changes. Then looks up the data from book 2 and if the date
doesn't exist will put the data in a new row. Then repeats with book 3.
Finally the code will sort the new workbook from row 4 to the end.

The code assume the first tab in each workbook contains the data.


Sub CombineBooks()

Set NewSht = ThisWorkbook.Sheets(1)
NewSht.ClearContents

File1 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 1")
If File1 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If

File2 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 2")
If File2 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If

File3 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 3")
If File3 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If


Set BK1 = Workbooks.Open(Filename:=File1)
Set BK1Sht = BK1.Sheets(1)
Set BK2 = Workbooks.Open(Filename:=File2)
Set Bk2Sht = BK2.Sheets(1)
Set BK3 = Workbooks.Open(Filename:=File3)
Set Bk3Sht = BK3.Sheets(1)

'Copy Bk 1 to current workbook
BK1Sht.Cells.Copy Destination:=NewSht.Cells
LastRow = NewSht.Range("A" & RowCount).End(xlUp).Row
NewRow = LastRow + 1

'Get Data from Book 2
RowCount = 2
With Bk2Sht
'Copy Header Row
.Range("B1:AA1").Copy Destination:=NewSht.Range("AY1")
Do While .Range("A" & RowCount) < ""
MyDate = .Range("A" & RowCount)
Set DataRange = .Range("B" & RowCount & ":AA" & RowCount)
'Look for Date in column A
Set c = NewSht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'Date not found, Put Line at end of sheet
DataRange.Copy _
Destination:=NewSht.Range("AY" & NewRow)
NewRow = NewRow + 1
Else
DataRange.Copy _
Destination:=NewSht.Range("AY" & c.Row)
End If
RowCount = RowCount + 1
Loop
End With

'Get Data from Book 3
RowCount = 2
With Bk3Sht
'Copy Header Row
.Range("B1:E1").Copy Destination:=NewSht.Range("BY1")
Do While .Range("A" & RowCount) < ""
MyDate = .Range("A" & RowCount)
Set DataRange = .Range("B" & RowCount & ":E" & RowCount)
'Look for Date in column A
Set c = NewSht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'Date not found, Put Line at end of sheet
DataRange.Copy _
Destination:=NewSht.Range("BY" & NewRow)
NewRow = NewRow + 1
Else
DataRange.Copy _
Destination:=NewSht.Range("BY" & c.Row)
End If
RowCount = RowCount + 1
Loop
End With

Set SortRange = NewSht.Rows("4:" & (NewRow - 1))
SortRange.Sort _
Key1:=NewSht.Range("A4"), _
order1:=xlAscending, _
header:=xlNo

BK1.Close savechanges:=False
BK2.Close savechanges:=False
BK3.Close savechanges:=False
End Sub


"Lucas Jammerson" wrote:

Hi,

I have three datasets in different excel workbooks which I need to
consolidate into one summary sheet but the three data block from each
sheet needs to be aligned by a common field in the three workbooks:
Column A which has dates for each block.

The set up of the different workbooks is as follows:

In each of the three workbooks, Column A has dates and row 1 as the name
of the indicators.

In the first workbook, the data starts in row 4 and column G and ends in
row 8632 (but this changes from week to week) and column AX.

In the second workbook, the data starts in row 2 and column B and ends
in row 5411 (changes week to week) and column AA.

In the third workbook, the data starts in row 2 and column B and ends in
row 6044 (changes week to week) and column E.

Is there a quick way to consolidate all the data by the date field into
a summary sheet from the three worksheets/books?

For example the summary sheet could look like this:

Column A = All possible dates contained in column A of the three files.
Columns G to AX would have data from the firstwook book aligned by the
date field. Columns AY to BX would have the data from the second
workbook aligned by date and BY to CB could contain the data from the
third file.

Would using vlookup or some kind of match function work to achieve this?
I'm seeking a VBA solution as in the past I've found having lots
functions in worksheets really slows down working with them.

Hope someone can help.

Thanks,

Lucas


*** Sent via Developersdex http://www.developersdex.com ***

Consolidating datasets from Excel workbook using common feild
 

Hi Joel,

Thanks for the code. That was quick!

I tried runing it with the set up you suggested and it returns a run
time error 1004: "Method Range of Object Worksheet Failed"

Debugging takes me to the following line in the code:

LastRow = newsht.Range("A" & RowCount).End(xlUp).Row

FROM THE BLOCK
'Copy Bk 1 to current workbook
BK1Sht.Cells.Copy Destination:=newsht.Cells
LastRow = newsht.Range("A" & RowCount).End(xlUp).Row
NewRow = LastRow + 1

In the consolidated workbook, data from the first file is populated but
that's it.

Any ideas why I may be getting this?

Thanks,

Lucas




*** Sent via Developersdex http://www.developersdex.com ***

Consolidating datasets from Excel workbook using common feild
 

I made a small typo. Also I forgot to put the DaTE IN cOLUMN a When I add
new rows. the code below contain the corrections

from
LastRow = newsht.Range("A" & RowCount).End(xlUp).Row
to
LastRow = newsht.Range("A" & Rows.Count).End(xlUp).Row



Sub CombineBooks()

Set NewSht = ThisWorkbook.Sheets(1)
NewSht.ClearContents

File1 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 1")
If File1 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If

File2 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 2")
If File2 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If

File3 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 3")
If File3 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If


Set BK1 = Workbooks.Open(Filename:=File1)
Set BK1Sht = BK1.Sheets(1)
Set BK2 = Workbooks.Open(Filename:=File2)
Set Bk2Sht = BK2.Sheets(1)
Set BK3 = Workbooks.Open(Filename:=File3)
Set Bk3Sht = BK3.Sheets(1)

'Copy Bk 1 to current workbook
BK1Sht.Cells.Copy Destination:=NewSht.Cells
LastRow = NewSht.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

'Get Data from Book 2
RowCount = 2
With Bk2Sht
'Copy Header Row
.Range("B1:AA1").Copy Destination:=NewSht.Range("AY1")
Do While .Range("A" & RowCount) < ""
MyDate = .Range("A" & RowCount)
Set DataRange = .Range("B" & RowCount & ":AA" & RowCount)
'Look for Date in column A
Set c = NewSht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'Date not found, Put Line at end of sheet
DataRange.Copy _
Destination:=NewSht.Range("AY" & NewRow)
NewRow = NewRow + 1
Else
DataRange.Copy _
Destination:=NewSht.Range("AY" & c.Row)
End If
RowCount = RowCount + 1
Loop
End With

'Get Data from Book 3
RowCount = 2
With Bk3Sht
'Copy Header Row
.Range("B1:E1").Copy Destination:=NewSht.Range("BY1")
Do While .Range("A" & RowCount) < ""
MyDate = .Range("A" & RowCount)
Set DataRange = .Range("B" & RowCount & ":E" & RowCount)
'Look for Date in column A
Set c = NewSht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'Date not found, Put Line at end of sheet
DataRange.Copy _
Destination:=NewSht.Range("BY" & NewRow)
NewSht.Range("A" & NewRow) = MyDate
NewRow = NewRow + 1
Else
DataRange.Copy _
Destination:=NewSht.Range("BY" & c.Row)
End If
RowCount = RowCount + 1
Loop
End With

Set SortRange = NewSht.Rows("4:" & (NewRow - 1))
SortRange.Sort _
Key1:=NewSht.Range("A4"), _
order1:=xlAscending, _
header:=xlNo

BK1.Close savechanges:=False
BK2.Close savechanges:=False
BK3.Close savechanges:=False
End Sub


"Lucas Jammerson" wrote:

Hi Joel,

Thanks for the code. That was quick!

I tried runing it with the set up you suggested and it returns a run
time error 1004: "Method Range of Object Worksheet Failed"

Debugging takes me to the following line in the code:

LastRow = newsht.Range("A" & RowCount).End(xlUp).Row

FROM THE BLOCK
'Copy Bk 1 to current workbook
BK1Sht.Cells.Copy Destination:=newsht.Cells
LastRow = newsht.Range("A" & RowCount).End(xlUp).Row
NewRow = LastRow + 1

In the consolidated workbook, data from the first file is populated but
that's it.

Any ideas why I may be getting this?

Thanks,

Lucas




*** Sent via Developersdex http://www.developersdex.com ***

Consolidating datasets from Excel workbook using common feild
 

Hello again,

Now it's generating runtime error 848 saying "Named argument not found"
taking me to the following line in the code:

'Look for Date in column A
Set c = newsht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)

Do I need to name the date range as mydate in the source files?

Lucas


*** Sent via Developersdex http://www.developersdex.com ***

Consolidating datasets from Excel workbook using common feild
 

I finally had time to completely test the code. The corrected cod is below

Set c = newsht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)

I spelled LOOKIN wrong. Had an extra "L".


Sub CombineBooks()

Set NewSht = ThisWorkbook.Sheets(1)
NewSht.Cells.ClearContents

File1 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 1")
If File1 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If

File2 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 2")
If File2 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If

File3 = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open File 3")
If File3 = False Then
MsgBox ("Cannot Open File - Exiting Macro")
End If


Set BK1 = Workbooks.Open(Filename:=File1)
Set BK1Sht = BK1.Sheets(1)
Set BK2 = Workbooks.Open(Filename:=File2)
Set Bk2Sht = BK2.Sheets(1)
Set BK3 = Workbooks.Open(Filename:=File3)
Set Bk3Sht = BK3.Sheets(1)

'Copy Bk 1 to current workbook
BK1Sht.Cells.Copy Destination:=NewSht.Cells
LastRow = NewSht.Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

'Get Data from Book 2
RowCount = 2
With Bk2Sht
'Copy Header Row
.Range("B1:AA1").Copy Destination:=NewSht.Range("AY1")
Do While .Range("A" & RowCount) < ""
MyDate = .Range("A" & RowCount)
Set DataRange = .Range("B" & RowCount & ":AA" & RowCount)
'Look for Date in column A
Set c = NewSht.Columns("A").Find(what:=MyDate, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'Date not found, Put Line at end of sheet
DataRange.Copy _
Destination:=NewSht.Range("AY" & NewRow)
NewSht.Range("A" & NewRow) = MyDate
NewRow = NewRow + 1
Else
DataRange.Copy _
Destination:=NewSht.Range("AY" & c.Row)
End If
RowCount = RowCount + 1
Loop
End With

'Get Data from Book 3
RowCount = 2
With Bk3Sht
'Copy Header Row
.Range("B1:E1").Copy Destination:=NewSht.Range("BY1")
Do While .Range("A" & RowCount) < ""
MyDate = .Range("A" & RowCount)
Set DataRange = .Range("B" & RowCount & ":E" & RowCount)
'Look for Date in column A
Set c = NewSht.Columns("A").Find(what:=MyDate, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'Date not found, Put Line at end of sheet
DataRange.Copy _
Destination:=NewSht.Range("BY" & NewRow)
NewSht.Range("A" & NewRow) = MyDate
NewRow = NewRow + 1
Else
DataRange.Copy _
Destination:=NewSht.Range("BY" & c.Row)
End If
RowCount = RowCount + 1
Loop
End With

Set SortRange = NewSht.Rows("4:" & (NewRow - 1))
SortRange.Sort _
Key1:=NewSht.Range("A4"), _
order1:=xlAscending, _
header:=xlNo

BK1.Close savechanges:=False
BK2.Close savechanges:=False
BK3.Close savechanges:=False
End Sub




"Lucas Jammerson" wrote:

Hello again,

Now it's generating runtime error 848 saying "Named argument not found"
taking me to the following line in the code:

'Look for Date in column A
Set c = newsht.Columns("A").Find(what:=MyDate, _
looklin:=xlValues, lookat:=xlWhole)

Do I need to name the date range as mydate in the source files?

Lucas


*** Sent via Developersdex http://www.developersdex.com ***

Consolidating datasets from Excel workbook using common feild
 

*** Sent via Developersdex http://www.developersdex.com ***