Help With Macro

W

wild turkey no9

I have data all structured in the same way (same column headings) across
multiple sheets within the same workbook. Is there an easy way to concatenate
all of the data, without any empty rows, into one summary sheet in the
workbook?

Thanks in advance.

Kevin
 
J

JLatham

What do you mean by concatenate in this context? Do you want the summary
sheet to contain all of the not-empty rows of data from all of the other
sheets? Or are you somehow wanting some kind of actual summary of the data
on the others?

If you do want all data from all other sheets, then the code below should
help. Be sure that data is not filtered on any sheets to definitely capture
all data. I took the easy way out and assumend that there is at least 1
column that will always have something in it on the sheets on any row that
needs to be copied. Since you said all sheets had same format, I think this
has a good chance of being true?

Sub BuildSummarySheet()
'note that this does not clear existing entries
'from the summary sheet, so multiple runs of
'it will result in replicated entries - you
'should manually clear all previous entries
'before running this code

'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")
'to improve performance
Application.ScreenUpdating = False
'begin the actual work
For Each anyWS In ThisWorkbook.Worksheets
If anyWS.Name <> summaryWS.Name Then
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
End If ' end test for sheet name matchup
Next ' end anyWS loop
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"

End Sub
 
W

wild turkey no9

Dear JLatham

This is totally awesome. Worked like a charm.

A quick explanation of why I'm doing this - using this idea to workaround
the limitations of multiple consolidation ranges using pivot tables.

Two more favors to ask. Could you add the funcionality to clear all rows on
the summary sheet, except for the first, each time the macro is run.

As one or more of the sheets may contain pivot tables or other data, can I
name the worksheets to include in the row concatenation?

Sorry to trouble you with this but I didn't think this through thoroughly
before asking my original question.

Thanks

Kevin
 
J

JLatham

That's easy for me to do, adds some work for you. Replace the old code with
that below. You'll still need to make the testCol = "A" change and the
change to the name of the summary worksheet.

There is now an array called addSheets() that you will have to "fill" with
the names of the sheets to be processed. Right now it is set to hold 3 sheet
names:
Dim addSheets(1 To 3) As String
to change the number of sheets to be processed, change the 3 to the total
number of them. After making that change add more
addSheets(#) = "Sheetname"
statements into the code, one for each sheet to be processed.

The code also checks to verify that you've typed the sheet names in
properly, and if it finds one that isn't quite right, it shows you the entry
from the array so you can fix things, and then quits the process. If you
encounter those, look for blanks at the beginning or end of the name as typed
into the sheet's name tab. That's probably the most common error in matching
sheet names.

It also deletes old data from the summary sheet before beginning to rebuild
the sheet. Here's the new code:

Sub BuildSummarySheet()
'JLatham, Excel MVP, 17 APR 2010
'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long
Dim SLC As Integer
'this array holds the names of the
'sheets that are to be included in
'the processing.
' Change the "To 3" to make it large
' enough to hold all names you need
Dim addSheets(1 To 3) As String

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")

'put the list of sheets to include
'into the array, modify as required
'note that these sheet names MUST be
'spelled and punctuated just like the
'names on those sheet's tabs.
'Case is not important:
' "Sheet1" = "SHEET1", but
' "Sheet1" <> "Sheet1 "
addSheets(1) = "Sheet2"
addSheets(2) = "SHEET3"
addSheets(3) = "Sheet4"

'this section added to test for valid
'sheet names, and inform you of any
'that can't be found - indicating
'a need to check the name spelling
'in the assignments above
On Error Resume Next
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
If Err <> 0 Then
Err.Clear
MsgBox "Check the name of sheet:" & vbCrLf _
& "[" & addSheets(SLC) & "]" & vbCrLf _
& "No sheet of that exact name found in this workbook", _
vbOKOnly + vbCritical, "Bad Sheet Name - Aborting"
On Error GoTo 0 ' clear error trapping
GoTo DoHouseCleaning ' exit w/cleanup
End If
Next ' end SLC loop
On Error GoTo 0 ' let system handle errors

'to improve performance
Application.ScreenUpdating = False

'delete all but the first row on the summary sheet
lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
summaryWS.Rows("2:" & lastRow).EntireRow.Delete
End If

'begin the actual work
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
Next ' end SLC loop
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"
DoHouseCleaning:
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
Set anyWS = Nothing
End Sub
 
W

wild turkey no9

Dear JL

Everything works fine until I enter a formula in one of the concetenated
sheets. Somehow the macro thinks there is data in the cell even if it is
blank. Did a little research and it looks like it is something to do with
using IsEmpty as the test. Tried hacking the code by changing IsEmpty to
IsBlank without success. I'm out of my depth here but I feel that a new
journey of discovery has begun!

It is beyond cheeky for me to ask for any more help but if you can, it would
be most appreciated.

Thanks

Kevin

JLatham said:
That's easy for me to do, adds some work for you. Replace the old code with
that below. You'll still need to make the testCol = "A" change and the
change to the name of the summary worksheet.

There is now an array called addSheets() that you will have to "fill" with
the names of the sheets to be processed. Right now it is set to hold 3 sheet
names:
Dim addSheets(1 To 3) As String
to change the number of sheets to be processed, change the 3 to the total
number of them. After making that change add more
addSheets(#) = "Sheetname"
statements into the code, one for each sheet to be processed.

The code also checks to verify that you've typed the sheet names in
properly, and if it finds one that isn't quite right, it shows you the entry
from the array so you can fix things, and then quits the process. If you
encounter those, look for blanks at the beginning or end of the name as typed
into the sheet's name tab. That's probably the most common error in matching
sheet names.

It also deletes old data from the summary sheet before beginning to rebuild
the sheet. Here's the new code:

Sub BuildSummarySheet()
'JLatham, Excel MVP, 17 APR 2010
'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long
Dim SLC As Integer
'this array holds the names of the
'sheets that are to be included in
'the processing.
' Change the "To 3" to make it large
' enough to hold all names you need
Dim addSheets(1 To 3) As String

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")

'put the list of sheets to include
'into the array, modify as required
'note that these sheet names MUST be
'spelled and punctuated just like the
'names on those sheet's tabs.
'Case is not important:
' "Sheet1" = "SHEET1", but
' "Sheet1" <> "Sheet1 "
addSheets(1) = "Sheet2"
addSheets(2) = "SHEET3"
addSheets(3) = "Sheet4"

'this section added to test for valid
'sheet names, and inform you of any
'that can't be found - indicating
'a need to check the name spelling
'in the assignments above
On Error Resume Next
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
If Err <> 0 Then
Err.Clear
MsgBox "Check the name of sheet:" & vbCrLf _
& "[" & addSheets(SLC) & "]" & vbCrLf _
& "No sheet of that exact name found in this workbook", _
vbOKOnly + vbCritical, "Bad Sheet Name - Aborting"
On Error GoTo 0 ' clear error trapping
GoTo DoHouseCleaning ' exit w/cleanup
End If
Next ' end SLC loop
On Error GoTo 0 ' let system handle errors

'to improve performance
Application.ScreenUpdating = False

'delete all but the first row on the summary sheet
lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
summaryWS.Rows("2:" & lastRow).EntireRow.Delete
End If

'begin the actual work
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
Next ' end SLC loop
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"
DoHouseCleaning:
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
Set anyWS = Nothing
End Sub

wild turkey no9 said:
Dear JLatham

This is totally awesome. Worked like a charm.

A quick explanation of why I'm doing this - using this idea to workaround
the limitations of multiple consolidation ranges using pivot tables.

Two more favors to ask. Could you add the funcionality to clear all rows on
the summary sheet, except for the first, each time the macro is run.

As one or more of the sheets may contain pivot tables or other data, can I
name the worksheets to include in the row concatenation?

Sorry to trouble you with this but I didn't think this through thoroughly
before asking my original question.

Thanks

Kevin
 
W

wild turkey no9

Dear JL

After further thought the correct test for the cell in column A would be
either = 0 or is blank......



wild turkey no9 said:
Dear JL

Everything works fine until I enter a formula in one of the concetenated
sheets. Somehow the macro thinks there is data in the cell even if it is
blank. Did a little research and it looks like it is something to do with
using IsEmpty as the test. Tried hacking the code by changing IsEmpty to
IsBlank without success. I'm out of my depth here but I feel that a new
journey of discovery has begun!

It is beyond cheeky for me to ask for any more help but if you can, it would
be most appreciated.

Thanks

Kevin

JLatham said:
That's easy for me to do, adds some work for you. Replace the old code with
that below. You'll still need to make the testCol = "A" change and the
change to the name of the summary worksheet.

There is now an array called addSheets() that you will have to "fill" with
the names of the sheets to be processed. Right now it is set to hold 3 sheet
names:
Dim addSheets(1 To 3) As String
to change the number of sheets to be processed, change the 3 to the total
number of them. After making that change add more
addSheets(#) = "Sheetname"
statements into the code, one for each sheet to be processed.

The code also checks to verify that you've typed the sheet names in
properly, and if it finds one that isn't quite right, it shows you the entry
from the array so you can fix things, and then quits the process. If you
encounter those, look for blanks at the beginning or end of the name as typed
into the sheet's name tab. That's probably the most common error in matching
sheet names.

It also deletes old data from the summary sheet before beginning to rebuild
the sheet. Here's the new code:

Sub BuildSummarySheet()
'JLatham, Excel MVP, 17 APR 2010
'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long
Dim SLC As Integer
'this array holds the names of the
'sheets that are to be included in
'the processing.
' Change the "To 3" to make it large
' enough to hold all names you need
Dim addSheets(1 To 3) As String

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")

'put the list of sheets to include
'into the array, modify as required
'note that these sheet names MUST be
'spelled and punctuated just like the
'names on those sheet's tabs.
'Case is not important:
' "Sheet1" = "SHEET1", but
' "Sheet1" <> "Sheet1 "
addSheets(1) = "Sheet2"
addSheets(2) = "SHEET3"
addSheets(3) = "Sheet4"

'this section added to test for valid
'sheet names, and inform you of any
'that can't be found - indicating
'a need to check the name spelling
'in the assignments above
On Error Resume Next
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
If Err <> 0 Then
Err.Clear
MsgBox "Check the name of sheet:" & vbCrLf _
& "[" & addSheets(SLC) & "]" & vbCrLf _
& "No sheet of that exact name found in this workbook", _
vbOKOnly + vbCritical, "Bad Sheet Name - Aborting"
On Error GoTo 0 ' clear error trapping
GoTo DoHouseCleaning ' exit w/cleanup
End If
Next ' end SLC loop
On Error GoTo 0 ' let system handle errors

'to improve performance
Application.ScreenUpdating = False

'delete all but the first row on the summary sheet
lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
summaryWS.Rows("2:" & lastRow).EntireRow.Delete
End If

'begin the actual work
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
Next ' end SLC loop
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"
DoHouseCleaning:
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
Set anyWS = Nothing
End Sub

wild turkey no9 said:
Dear JLatham

This is totally awesome. Worked like a charm.

A quick explanation of why I'm doing this - using this idea to workaround
the limitations of multiple consolidation ranges using pivot tables.

Two more favors to ask. Could you add the funcionality to clear all rows on
the summary sheet, except for the first, each time the macro is run.

As one or more of the sheets may contain pivot tables or other data, can I
name the worksheets to include in the row concatenation?

Sorry to trouble you with this but I didn't think this through thoroughly
before asking my original question.

Thanks

Kevin





:

What do you mean by concatenate in this context? Do you want the summary
sheet to contain all of the not-empty rows of data from all of the other
sheets? Or are you somehow wanting some kind of actual summary of the data
on the others?

If you do want all data from all other sheets, then the code below should
help. Be sure that data is not filtered on any sheets to definitely capture
all data. I took the easy way out and assumend that there is at least 1
column that will always have something in it on the sheets on any row that
needs to be copied. Since you said all sheets had same format, I think this
has a good chance of being true?

Sub BuildSummarySheet()
'note that this does not clear existing entries
'from the summary sheet, so multiple runs of
'it will result in replicated entries - you
'should manually clear all previous entries
'before running this code

'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")
'to improve performance
Application.ScreenUpdating = False
'begin the actual work
For Each anyWS In ThisWorkbook.Worksheets
If anyWS.Name <> summaryWS.Name Then
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
End If ' end test for sheet name matchup
Next ' end anyWS loop
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"

End Sub


:

I have data all structured in the same way (same column headings) across
multiple sheets within the same workbook. Is there an easy way to concatenate
all of the data, without any empty rows, into one summary sheet in the
workbook?

Thanks in advance.

Kevin
 
W

wild turkey no9

Dear JL

I figured out the answer for myself.

Anyways, I'm not sure if you do this stuff for a living and are looking for
project based work in this area. If you're interested please drop me a line
at (e-mail address removed).

Thanks again for all your help.

Kevin

wild turkey no9 said:
Dear JL

After further thought the correct test for the cell in column A would be
either = 0 or is blank......



wild turkey no9 said:
Dear JL

Everything works fine until I enter a formula in one of the concetenated
sheets. Somehow the macro thinks there is data in the cell even if it is
blank. Did a little research and it looks like it is something to do with
using IsEmpty as the test. Tried hacking the code by changing IsEmpty to
IsBlank without success. I'm out of my depth here but I feel that a new
journey of discovery has begun!

It is beyond cheeky for me to ask for any more help but if you can, it would
be most appreciated.

Thanks

Kevin

JLatham said:
That's easy for me to do, adds some work for you. Replace the old code with
that below. You'll still need to make the testCol = "A" change and the
change to the name of the summary worksheet.

There is now an array called addSheets() that you will have to "fill" with
the names of the sheets to be processed. Right now it is set to hold 3 sheet
names:
Dim addSheets(1 To 3) As String
to change the number of sheets to be processed, change the 3 to the total
number of them. After making that change add more
addSheets(#) = "Sheetname"
statements into the code, one for each sheet to be processed.

The code also checks to verify that you've typed the sheet names in
properly, and if it finds one that isn't quite right, it shows you the entry
from the array so you can fix things, and then quits the process. If you
encounter those, look for blanks at the beginning or end of the name as typed
into the sheet's name tab. That's probably the most common error in matching
sheet names.

It also deletes old data from the summary sheet before beginning to rebuild
the sheet. Here's the new code:

Sub BuildSummarySheet()
'JLatham, Excel MVP, 17 APR 2010
'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long
Dim SLC As Integer
'this array holds the names of the
'sheets that are to be included in
'the processing.
' Change the "To 3" to make it large
' enough to hold all names you need
Dim addSheets(1 To 3) As String

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")

'put the list of sheets to include
'into the array, modify as required
'note that these sheet names MUST be
'spelled and punctuated just like the
'names on those sheet's tabs.
'Case is not important:
' "Sheet1" = "SHEET1", but
' "Sheet1" <> "Sheet1 "
addSheets(1) = "Sheet2"
addSheets(2) = "SHEET3"
addSheets(3) = "Sheet4"

'this section added to test for valid
'sheet names, and inform you of any
'that can't be found - indicating
'a need to check the name spelling
'in the assignments above
On Error Resume Next
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
If Err <> 0 Then
Err.Clear
MsgBox "Check the name of sheet:" & vbCrLf _
& "[" & addSheets(SLC) & "]" & vbCrLf _
& "No sheet of that exact name found in this workbook", _
vbOKOnly + vbCritical, "Bad Sheet Name - Aborting"
On Error GoTo 0 ' clear error trapping
GoTo DoHouseCleaning ' exit w/cleanup
End If
Next ' end SLC loop
On Error GoTo 0 ' let system handle errors

'to improve performance
Application.ScreenUpdating = False

'delete all but the first row on the summary sheet
lastRow = summaryWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
summaryWS.Rows("2:" & lastRow).EntireRow.Delete
End If

'begin the actual work
For SLC = LBound(addSheets) To UBound(addSheets)
Set anyWS = ThisWorkbook.Worksheets(addSheets(SLC))
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
Next ' end SLC loop
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"
DoHouseCleaning:
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
Set anyWS = Nothing
End Sub

:

Dear JLatham

This is totally awesome. Worked like a charm.

A quick explanation of why I'm doing this - using this idea to workaround
the limitations of multiple consolidation ranges using pivot tables.

Two more favors to ask. Could you add the funcionality to clear all rows on
the summary sheet, except for the first, each time the macro is run.

As one or more of the sheets may contain pivot tables or other data, can I
name the worksheets to include in the row concatenation?

Sorry to trouble you with this but I didn't think this through thoroughly
before asking my original question.

Thanks

Kevin





:

What do you mean by concatenate in this context? Do you want the summary
sheet to contain all of the not-empty rows of data from all of the other
sheets? Or are you somehow wanting some kind of actual summary of the data
on the others?

If you do want all data from all other sheets, then the code below should
help. Be sure that data is not filtered on any sheets to definitely capture
all data. I took the easy way out and assumend that there is at least 1
column that will always have something in it on the sheets on any row that
needs to be copied. Since you said all sheets had same format, I think this
has a good chance of being true?

Sub BuildSummarySheet()
'note that this does not clear existing entries
'from the summary sheet, so multiple runs of
'it will result in replicated entries - you
'should manually clear all previous entries
'before running this code

'this all depends on there being one
'column that will always have data in it
'on any row that has data change this
'Const value to indicate that column
Const testCol = "A"
Dim summaryWS As Worksheet
Dim anyWS As Worksheet
Dim lastRow As Long
Dim testList As Range
Dim anyTestCell As Range
Dim row2Copy As Range
Dim rowPointer As Long

'change this to the summary sheet's name
Set summaryWS = ThisWorkbook.Worksheets("Sheet1")
'to improve performance
Application.ScreenUpdating = False
'begin the actual work
For Each anyWS In ThisWorkbook.Worksheets
If anyWS.Name <> summaryWS.Name Then
lastRow = anyWS.Range(testCol & Rows.Count).End(xlUp).Row
If lastRow > 1 Then
Set testList = anyWS.Range(testCol & "2:" & _
testCol & lastRow)
For Each anyTestCell In testList
If Not IsEmpty(anyTestCell) Then
Set row2Copy = anyWS.Rows(anyTestCell.Row & _
":" & anyTestCell.Row)
row2Copy.Copy
summaryWS.Range(testCol & Rows.Count).End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
'if you also want formats copied, then
'remove the ' in front of this next line of code
'summaryWS.Range(testCol & Rows.Count).End(xlUp). _
PasteSpecial xlPasteFormats
End If ' end IsEmpty test block
Next ' end anyTestCell loop
End If 'end test for lastRow
End If ' end test for sheet name matchup
Next ' end anyWS loop
'do some housekeeping
Set testList = Nothing
Set row2Copy = Nothing
Set summaryWS = Nothing
MsgBox "Summary Sheet Build Completed", vbOKOnly, "Job Done"

End Sub


:

I have data all structured in the same way (same column headings) across
multiple sheets within the same workbook. Is there an easy way to concatenate
all of the data, without any empty rows, into one summary sheet in the
workbook?

Thanks in advance.

Kevin
 

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