Data Tools - Consolidate Excel 2007

M

Melanie

I have 13 worksheets that I need to consolidate onto one sheet. I've tried
using codes from VB and they error out or give unwanted results.

I want to use consolidate from the data tools group. I've followed the steps
provided by help and even though the function appears to execute; no results
show. Can someone help me out?
 
M

Melanie

I've tried the VB scripts provided and they error out at:

'Find the last row with data on the DestSh
Last = LastRow(DestSh)
 
R

Ron de Bruin

Hi Melanie

When you read the information above the macro it say

Important:
The macro examples use the LastRow or LastCol function that you can find in the last section of this page.

So copy the function also in the same module as the macro.
Let me know if you need more help



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




Melanie said:
I've tried the VB scripts provided and they error out at:

'Find the last row with data on the DestSh
Last = LastRow(DestSh)
 
M

Melanie

Yes, I read that but, I don't understand where in the series of commands do I
insert the additional function. The directions don't provide enough detail
for a novice.
 
R

Ron de Bruin

Hi

Sorry I think this part of the page is not so bad <g>
Download also the Example workbook so you can see it working


Where do I copy the macros and functions from this page?

1. Alt-F11
2. Insert>Module from the Menu bar
3. Paste the Code there
4. Alt-Q to go back to Excel
5. Alt-F8 to run the subs

Common Functions required for all routines:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function





--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




Melanie said:
Yes, I read that but, I don't understand where in the series of commands do I
insert the additional function. The directions don't provide enough detail
for a novice.
 
G

Gord Dibben

Just copy the LastRow and LastCol functions from Ron's site and paste them
into the same module where you placed the other code.

They are separate functions and are not inserted into any existing code.


Gord Dibben MS Excel MVP
 
M

Melanie

Since I am able to get the script to error out, I thought it was understood
that I know the steps of 1-5. That is a given.

Please disregard my question about where to paste the common function code.
I pasted it at the end of the "Copy a range of each sheet" code and ended up
undesired results and with the error "There are not enough rows in the
Destsh". Below is the code and a sample of the results.

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh
Last = LastRow(DestSh)

'Fill in the range that you want to copy
Set CopyRng = sh.Range("A:C")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below
this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value =
sh.Name

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

RESULTS

Date Description Amount 7-Dec
12/7/2007 Purchase Description $5.98 7-Dec
12/7/2007 Purchase Description $22.40 7-Dec
12/8/2007 Purchase Description $21.60 7-Dec
12/8/2007 Purchase Description $48.29 7-Dec
12/8/2007 Purchase Description $85.25 7-Dec
12/8/2007 Purchase Description $125.98 7-Dec
12/8/2007 Purchase Description $3.45 7-Dec
12/8/2007 Purchase Description $39.94 7-Dec
12/8/2007 Purchase Description $21.07 7-Dec

The results only displayed data from the first sheet of the workbook and it
converts the name of first sheet from "Dec07" to "7-Dec" and fills this data
down the entire H column, all 1048576 rows; hence the error message.

PS - The link provided with your response was broken and once I found my
post, I received a message "Community Message Not Available". I had to click
on the ? mark and then I was able to see your recent response.


Thanks,
Melanie
 
R

Ron de Bruin

Hi Melanie
undesired results and with the error "There are not enough rows in the
Destsh". Below is the code and a sample of the results.

Look in each sheet if the last cell with data is the correct last cell you think

Use the Shortcut Ctrl End to jump to the last cell in each worksheet
converts the name of first sheet from "Dec07" to "7-Dec
For the name you can use

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = "'" & sh.Name



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




Melanie said:
Since I am able to get the script to error out, I thought it was understood
that I know the steps of 1-5. That is a given.

Please disregard my question about where to paste the common function code.
I pasted it at the end of the "Copy a range of each sheet" code and ended up
undesired results and with the error "There are not enough rows in the
Destsh". Below is the code and a sample of the results.

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh
Last = LastRow(DestSh)

'Fill in the range that you want to copy
Set CopyRng = sh.Range("A:C")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below
this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value =
sh.Name

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

RESULTS

Date Description Amount 7-Dec
12/7/2007 Purchase Description $5.98 7-Dec
12/7/2007 Purchase Description $22.40 7-Dec
12/8/2007 Purchase Description $21.60 7-Dec
12/8/2007 Purchase Description $48.29 7-Dec
12/8/2007 Purchase Description $85.25 7-Dec
12/8/2007 Purchase Description $125.98 7-Dec
12/8/2007 Purchase Description $3.45 7-Dec
12/8/2007 Purchase Description $39.94 7-Dec
12/8/2007 Purchase Description $21.07 7-Dec

The results only displayed data from the first sheet of the workbook and it
converts the name of first sheet from "Dec07" to "7-Dec" and fills this data
down the entire H column, all 1048576 rows; hence the error message.

PS - The link provided with your response was broken and once I found my
post, I received a message "Community Message Not Available". I had to click
on the ? mark and then I was able to see your recent response.


Thanks,
Melanie
 
M

Melanie

I understand the answer that you provided for the H column issue, but I don't
understand the more problematic issue of the last cell with data.

Looking at each sheet isn't a solution. I can clearly see that it is only
consolidating the data from the first sheet in the workbook. This does not
need to be validated.

Each sheet has a different number of transactions, therefore, I do not want
to limit the range. The code moves the data from sheet Dec07 including any
blank rows. Once the Destsh is full it returns the error "There are not
enough rows in the Destsh". I need code that recognizes the last row with
data from Dec07. I need code that doesn't move blank rows, thus allowing the
loop to work correctly and pull data from each subsequent worksheet Jan08,
Feb08, Mar08....

The current code does the following:

Date Description Amount
1/2/2008 Payment Received -- Thank You ($1,300.00) Dec07
1/3/2008 Purchase Description $4.76 Dec07
1/3/2008 Purchase Description $31.92 Dec07
1/4/2008 Purchase Description $4.70 Dec07
1/5/2008 Purchase Description $66.07 Dec07
1/8/2008 Purchase Description $39.00 Dec07
Dec07
Dec07
Dec07
Dec07
Dec07

The worksheet name Dec07 runs from H1:H1048576. These results from this
optional code step validates that the code is moving blank rows from Dec07.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top