ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Combining multiple sheets (https://www.excelbanter.com/excel-discussion-misc-queries/148518-combining-multiple-sheets.html)

Dallman Ross

Combining multiple sheets
 
I know I've seen tips on this here before, but I can't
find them now.

I have set up some web-queries that are on 6 sheets
in a workbook. (The source data is paginated; setting
up 6 queries, one for each page, was my solution.)

Now I want to work out a macro to combine the data from
the pages into a new workbook. I'd like to copy various
of the cells based on filtering criteria and edit others.

But we could start out more simply. Would someone be able
to get me going in the right direction with some sample
VBA that just cycles through the pages and finds and copies
the ranges of data into the new sheet? Would be most appreciated.

--
dman

Peo Sjoblom

Combining multiple sheets
 
http://www.rondebruin.nl/summary.htm



--


Regards,

Peo Sjoblom

Excel 95 - Excel 2007
Northwest Excel Solutions
www.nwexcelsolutions.com
(Remove ^^ from email)



"Dallman Ross" <dman@localhost. wrote in message
...
I know I've seen tips on this here before, but I can't
find them now.

I have set up some web-queries that are on 6 sheets
in a workbook. (The source data is paginated; setting
up 6 queries, one for each page, was my solution.)

Now I want to work out a macro to combine the data from
the pages into a new workbook. I'd like to copy various
of the cells based on filtering criteria and edit others.

But we could start out more simply. Would someone be able
to get me going in the right direction with some sample
VBA that just cycles through the pages and finds and copies
the ranges of data into the new sheet? Would be most appreciated.

--
dman




JLatham

Combining multiple sheets
 
In addition to the information Peo has pointed out, I'll add this code as a
possible source of more information. As you asked, this is pretty primitive
and works in a rather confined scenario (row 1 has headers for all used
columns, and column A has entries for all used rows without empty cells until
last entry). This code adds it all to a new sheet each time it's run, not
into a new workbook.

Sub CombineWorksheets()
Dim newSheet As Worksheet
Dim anySheet As Worksheet
Dim rOffset As Long
Dim lastRow As Long
Dim lastCol As Long ' for Excel 2007
Dim lastColID As String
Dim maxRows As Long
Dim rangeToCopy As Range
Dim newLocation As String

'get last possible row number based on
'version of Excel in use
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007
maxRows = Rows.Count
lastColID = "IV" 'last in pre-2007
Else
maxRows = Rows.countlarge
lastColID = "XFD" ' last in 2007
End If

'add new sheet to end of the book
Worksheets.Add _
after:=Worksheets(Worksheets.Count)
Set newSheet = ActiveSheet
'work through all sheets in the workbook
For Each anySheet In Worksheets
'don't process new sheet
If anySheet.Name < newSheet.Name Then
'find last row based on
'a column we can expect to
'always have data all the way
'down the used area on a sheet
'this column could be different
'for each sheet, but code assumes
'that column A is good for this on
'all sheets
lastRow = anySheet.Range("A" & maxRows).End(xlUp).Row
'this assumes that you have a header row
'in row 1 of the sheets that has no
'empty cells until the 'list' ends
lastCol = anySheet.Range(lastColID & "1").End(xlToLeft).Column
'set up to grab all used information
Set rangeToCopy = anySheet.Range("A1:" & _
Range("A1").Offset(lastRow - 1, lastCol - 1).Address)
'set up to put the values from rangeToCopy
'into on the new sheet in head-to-tail fashion
rangeToCopy.Copy
newLocation = Range("A1").Offset(rOffset, 0).Address
'paste the values into the new sheet
newSheet.Range(newLocation).PasteSpecial xlPasteValues
rOffset = rOffset + rangeToCopy.Rows.Count
End If ' sheet name test
Next ' anySheet loop
End Sub


"Dallman Ross" wrote:

I know I've seen tips on this here before, but I can't
find them now.

I have set up some web-queries that are on 6 sheets
in a workbook. (The source data is paginated; setting
up 6 queries, one for each page, was my solution.)

Now I want to work out a macro to combine the data from
the pages into a new workbook. I'd like to copy various
of the cells based on filtering criteria and edit others.

But we could start out more simply. Would someone be able
to get me going in the right direction with some sample
VBA that just cycles through the pages and finds and copies
the ranges of data into the new sheet? Would be most appreciated.

--
dman


Dallman Ross

Combining multiple sheets
 
In , Peo Sjoblom
spake thusly:

http://www.rondebruin.nl/summary.htm


Excellent stuff there. Thanks. I'm trying it out.

Dallman

Dallman Ross

Combining multiple sheets
 
In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

In addition to the information Peo has pointed out, I'll add this code as a
possible source of more information. As you asked, this is pretty primitive
and works in a rather confined scenario (row 1 has headers for all used
columns, and column A has entries for all used rows without empty cells until
last entry). This code adds it all to a new sheet each time it's run, not
into a new workbook.


Thanks very much! I'll definitely try it out. It may take me
a few days to make something of all this stuff, but I'll try to
report back.

Dallman

========================================
Sub CombineWorksheets()
Dim newSheet As Worksheet
Dim anySheet As Worksheet
Dim rOffset As Long
Dim lastRow As Long
Dim lastCol As Long ' for Excel 2007
Dim lastColID As String
Dim maxRows As Long
Dim rangeToCopy As Range
Dim newLocation As String

'get last possible row number based on
'version of Excel in use
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007
maxRows = Rows.Count
lastColID = "IV" 'last in pre-2007
Else
maxRows = Rows.countlarge
lastColID = "XFD" ' last in 2007
End If

'add new sheet to end of the book
Worksheets.Add _
after:=Worksheets(Worksheets.Count)
Set newSheet = ActiveSheet
'work through all sheets in the workbook
For Each anySheet In Worksheets
'don't process new sheet
If anySheet.Name < newSheet.Name Then
'find last row based on
'a column we can expect to
'always have data all the way
'down the used area on a sheet
'this column could be different
'for each sheet, but code assumes
'that column A is good for this on
'all sheets
lastRow = anySheet.Range("A" & maxRows).End(xlUp).Row
'this assumes that you have a header row
'in row 1 of the sheets that has no
'empty cells until the 'list' ends
lastCol = anySheet.Range(lastColID & "1").End(xlToLeft).Column
'set up to grab all used information
Set rangeToCopy = anySheet.Range("A1:" & _
Range("A1").Offset(lastRow - 1, lastCol - 1).Address)
'set up to put the values from rangeToCopy
'into on the new sheet in head-to-tail fashion
rangeToCopy.Copy
newLocation = Range("A1").Offset(rOffset, 0).Address
'paste the values into the new sheet
newSheet.Range(newLocation).PasteSpecial xlPasteValues
rOffset = rOffset + rangeToCopy.Rows.Count
End If ' sheet name test
Next ' anySheet loop
End Sub


"Dallman Ross" wrote:

I know I've seen tips on this here before, but I can't
find them now.

I have set up some web-queries that are on 6 sheets
in a workbook. (The source data is paginated; setting
up 6 queries, one for each page, was my solution.)

Now I want to work out a macro to combine the data from
the pages into a new workbook. I'd like to copy various
of the cells based on filtering criteria and edit others.

But we could start out more simply. Would someone be able
to get me going in the right direction with some sample
VBA that just cycles through the pages and finds and copies
the ranges of data into the new sheet? Would be most appreciated.


Dallman Ross

Combining multiple sheets
 
In , Dallman Ross <dman@localhost.
spake thusly:

In , Peo Sjoblom
spake thusly:

http://www.rondebruin.nl/summary.htm


Excellent stuff there. Thanks. I'm trying it out.


I find Ron de Bruin's stuff highly useful. I appreciated
Mr. Latham's code too. I am studying all of it.

I have to settle on something, and for now I am working through
Ron's code, but this one rather than the summary macro peo showed us:

http://www.rondebruin.nl/copy2.htm

I have stuff I don't care about on the first row, and
rows 2-3 are repeated headers. So I went with this part
from down lower on Ron's page I just cited:

Copy from row 2 till the last row with data

That is working. I've started on Row 4, where my data begins.
It worked well. But now I want to fix it up. Here are
my first 3 concerns:

1) I want to copy the header rows (2-3), but only from the first sheet
copied.

2) In Row 1 of the sheets is something potentially helpful to the macro:
it says:

Page 1 2 3 4 5

I have that row hidden on the sheets, but I would like the macro
to look there and find that "5" is the last sheet and not bother
trying to copy (empty, but for the header rows) sheets after that
in my workbook.

(Sometimes there are more or fewer pages to the data. I have
the queries set up for more than I expect to need, and the last
pages end up blank.)

Alternatively, we could not bother with that but just look to
make sure there is data on Row 4 (A4) and skip trying to copy
the sheet if there is not.


3) I don't want to copy rows that say "Canceled" in Column A.


Here's something else I added to the code already:

DestSh.UsedRange.Columns.WrapText = False 'dman
DestSh.UsedRange.Columns.AutoFit 'dman

I did that right after the loop through the workseehts closes. It
works as I'd hoped.

Thanks for any help here. Break it down -- if you can help
with any of (1), (2), or (3) I've listed, please post. I'd
very much appreciate it.

Dallman

P.S. Here is Ron's code that I'm using, except I'm copying from Row 4:

http://www.rondebruin.nl/copy2.htm excerpt:
---------------------------------------------
Copy from row 2 till the last row with data

Note: This example use the function LastRow
Important: Be sure that there is no empty sheet in your workbook

We can copy all cells on the sheet with this line:
sh.UsedRange.Copy DestSh.Cells(Last + 1, "A")

But what if we do not want to copy the same header row each time.
The example below will copy from row 2 till the last row with data on each sheet

Sub Test2()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A")

End If
Next

Application.Goto DestSh.Cells(1)

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

JLatham

Combining multiple sheets
 
For the first request, copying from row 2 on first sheet, row 4 for the rest:

Add this to the variable declarations:
Dim sRow as Integer

then somewhere before the beginning of the For Each sh... loop add this
statement:
sRow = 2

Change the line that really does the work ( sh.Range(sh.Rows(2))...
to use sRow instead of 2:
sh.Range(sh.Rows(sRow))....
and right below that line of code add:
sRow=4

The first time the loop is run it will copy from row 2, and after that it
will always copy from row 4.

The code below includes those changes, plus it adds a test within the loop
to see if A4 is empty, and if it is empty, the copy is not performed. Your
3rd request, not to copy individual rows if they contain the word "Canceled"
in column A is a little more difficult since Ron's code (and even mine) is
copying a large area based on a start and end point and without regard to
what's in between. Probably best to add another routine to go to the
MergeSheet and delete rows that have Canceled in column A after all of the
work performed by the loop in this code is finished. Here's my modification
to your displayed code
Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim sRow As Integer ' jlatham

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
If Not IsEmpty(sh.Range("A4")) Then 'jlatham
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(sRow), sh.Rows(shLast)).Copy _
DestSh.Cells(Last + 1, "A")
sRow = 4 ' jlatham
End If ' jlatham
End If
Next

Application.Goto DestSh.Cells(1)

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

"Dallman Ross" wrote:

In , Dallman Ross <dman@localhost.
spake thusly:

In , Peo Sjoblom
spake thusly:

http://www.rondebruin.nl/summary.htm


Excellent stuff there. Thanks. I'm trying it out.


I find Ron de Bruin's stuff highly useful. I appreciated
Mr. Latham's code too. I am studying all of it.

I have to settle on something, and for now I am working through
Ron's code, but this one rather than the summary macro peo showed us:

http://www.rondebruin.nl/copy2.htm

I have stuff I don't care about on the first row, and
rows 2-3 are repeated headers. So I went with this part
from down lower on Ron's page I just cited:

Copy from row 2 till the last row with data

That is working. I've started on Row 4, where my data begins.
It worked well. But now I want to fix it up. Here are
my first 3 concerns:

1) I want to copy the header rows (2-3), but only from the first sheet
copied.

2) In Row 1 of the sheets is something potentially helpful to the macro:
it says:

Page 1 2 3 4 5

I have that row hidden on the sheets, but I would like the macro
to look there and find that "5" is the last sheet and not bother
trying to copy (empty, but for the header rows) sheets after that
in my workbook.

(Sometimes there are more or fewer pages to the data. I have
the queries set up for more than I expect to need, and the last
pages end up blank.)

Alternatively, we could not bother with that but just look to
make sure there is data on Row 4 (A4) and skip trying to copy
the sheet if there is not.


3) I don't want to copy rows that say "Canceled" in Column A.


Here's something else I added to the code already:

DestSh.UsedRange.Columns.WrapText = False 'dman
DestSh.UsedRange.Columns.AutoFit 'dman

I did that right after the loop through the workseehts closes. It
works as I'd hoped.

Thanks for any help here. Break it down -- if you can help
with any of (1), (2), or (3) I've listed, please post. I'd
very much appreciate it.

Dallman

P.S. Here is Ron's code that I'm using, except I'm copying from Row 4:

http://www.rondebruin.nl/copy2.htm excerpt:
---------------------------------------------
Copy from row 2 till the last row with data

Note: This example use the function LastRow
Important: Be sure that there is no empty sheet in your workbook

We can copy all cells on the sheet with this line:
sh.UsedRange.Copy DestSh.Cells(Last + 1, "A")

But what if we do not want to copy the same header row each time.
The example below will copy from row 2 till the last row with data on each sheet

Sub Test2()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A")

End If
Next

Application.Goto DestSh.Cells(1)

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


Dallman Ross

Combining multiple sheets
 
In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

Great help! At first your code offered didn't work, and I was getting
frustrated. Then I realized you hadn't inserted the "sRow = 2" statement
in that you described before showing the code. I put it in, and it
all works just fine! Thank you.

Your 3rd request, not to copy individual rows if they contain
the word "Canceled" in column A is a little more difficult since
Ron's code (and even mine) is copying a large area based on a
start and end point and without regard to what's in between.
Probably best to add another routine to go to the MergeSheet and
delete rows that have Canceled in column A after all of the work
performed by the loop in this code is finished.


Understood. I'm going to work on this now. I hope I can use
the same 'DestSh.UsedRange' stuff that's in the code. Otherwise,
I'll have to figure it out with some trial and error.

Another thing is, I want to drop the formatting when I copy.
(Then I'll add formatting latter in an add-on macro.) How
can I do that?

Dallman


---------------------------------------------------------------------
For the first request, copying from row 2 on first sheet, row 4
for the rest:

Add this to the variable declarations:
Dim sRow as Integer

then somewhere before the beginning of the For Each sh... loop
add this statement:
sRow = 2

Change the line that really does the work ( sh.Range(sh.Rows(2))...
to use sRow instead of 2:
sh.Range(sh.Rows(sRow))....
and right below that line of code add:
sRow=4

The first time the loop is run it will copy from row 2, and after that it
will always copy from row 4.
The code below includes those changes, plus it adds a test within the loop
to see if A4 is empty, and if it is empty, the copy is not performed. Your
3rd request, not to copy individual rows if they contain the word "Canceled"
in column A is a little more difficult since Ron's code (and even mine) is
copying a large area based on a start and end point and without regard to
what's in between. Probably best to add another routine to go to the
MergeSheet and delete rows that have Canceled in column A after all of the
work performed by the loop in this code is finished. Here's my modification
to your displayed code
Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim sRow As Integer ' jlatham

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
If Not IsEmpty(sh.Range("A4")) Then 'jlatham
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(sRow), sh.Rows(shLast)).Copy _
DestSh.Cells(Last + 1, "A")
sRow = 4 ' jlatham
End If ' jlatham
End If
Next

Application.Goto DestSh.Cells(1)

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

"Dallman Ross" wrote:

In , Dallman Ross <dman@localhost.
spake thusly:

In , Peo Sjoblom
spake thusly:

http://www.rondebruin.nl/summary.htm

Excellent stuff there. Thanks. I'm trying it out.


I find Ron de Bruin's stuff highly useful. I appreciated
Mr. Latham's code too. I am studying all of it.

I have to settle on something, and for now I am working through
Ron's code, but this one rather than the summary macro peo showed us:

http://www.rondebruin.nl/copy2.htm

I have stuff I don't care about on the first row, and
rows 2-3 are repeated headers. So I went with this part
from down lower on Ron's page I just cited:

Copy from row 2 till the last row with data

That is working. I've started on Row 4, where my data begins.
It worked well. But now I want to fix it up. Here are
my first 3 concerns:

1) I want to copy the header rows (2-3), but only from the first sheet
copied.

2) In Row 1 of the sheets is something potentially helpful to the macro:
it says:

Page 1 2 3 4 5

I have that row hidden on the sheets, but I would like the macro
to look there and find that "5" is the last sheet and not bother
trying to copy (empty, but for the header rows) sheets after that
in my workbook.

(Sometimes there are more or fewer pages to the data. I have
the queries set up for more than I expect to need, and the last
pages end up blank.)

Alternatively, we could not bother with that but just look to
make sure there is data on Row 4 (A4) and skip trying to copy
the sheet if there is not.


3) I don't want to copy rows that say "Canceled" in Column A.


Here's something else I added to the code already:

DestSh.UsedRange.Columns.WrapText = False 'dman
DestSh.UsedRange.Columns.AutoFit 'dman

I did that right after the loop through the workseehts closes. It
works as I'd hoped.

Thanks for any help here. Break it down -- if you can help
with any of (1), (2), or (3) I've listed, please post. I'd
very much appreciate it.

Dallman

P.S. Here is Ron's code that I'm using, except I'm copying from Row 4:

http://www.rondebruin.nl/copy2.htm excerpt:
---------------------------------------------
Copy from row 2 till the last row with data
[snip]


Dallman Ross

Combining multiple sheets
 
In , Dallman Ross <dman@localhost.
spake thusly:

Another thing is, I want to drop the formatting when I copy.
(Then I'll add formatting latter in an add-on macro.) How
can I do that?


Okay, I've stuck this near the end of Ron's/JLatham's VBA after the
'Next' statement. It seems to do what I want with the formatting.
Not sure if there's a cleaner way.


DestSh.UsedRange.Columns.WrapText = False 'dman
DestSh.UsedRange.Columns.AutoFit 'dman

'/* dman
' formatting stuff
DestSh.UsedRange.Select
Selection.Interior.ColorIndex = xlNone 'unformat
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(ROW(),2)"
Selection.FormatConditions(1).Interior.ColorIndex = 24
DestSh.Range("A1", "F2").Select
Selection.FormatConditions.Delete
Selection.Interior.ColorIndex = 37
'dman */

Now I'm going to figure out looking for

Dallman

---------------------------------------------------------------------
For the first request, copying from row 2 on first sheet, row 4
for the rest:

Add this to the variable declarations:
Dim sRow as Integer

then somewhere before the beginning of the For Each sh... loop
add this statement:
sRow = 2

Change the line that really does the work ( sh.Range(sh.Rows(2))...
to use sRow instead of 2:
sh.Range(sh.Rows(sRow))....
and right below that line of code add:
sRow=4

The first time the loop is run it will copy from row 2, and
after that it will always copy from row 4.
The code below includes those changes, plus it adds a test
within the loop to see if A4 is empty, and if it is empty,
the copy is not performed. Your 3rd request, not to copy
individual rows if they contain the word "Canceled" in column
A is a little more difficult since Ron's code (and even mine)
is copying a large area based on a start and end point and
without regard to what's in between. Probably best to add
another routine to go to the MergeSheet and delete rows that
have Canceled in column A after all of the work performed by
the loop in this code is finished. Here's my modification to
your displayed code
Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim sRow As Integer ' jlatham

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
If Not IsEmpty(sh.Range("A4")) Then 'jlatham
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(sRow), sh.Rows(shLast)).Copy _
DestSh.Cells(Last + 1, "A")
sRow = 4 ' jlatham
End If ' jlatham
End If
Next

Application.Goto DestSh.Cells(1)

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


Dallman Ross

Combining multiple sheets
 
In , Dallman Ross <dman@localhost.
spake thusly:

Another thing is, I want to drop the formatting when I copy.
(Then I'll add formatting latter in an add-on macro.) How
can I do that?


Okay, I've stuck this near the end of Ron's/JLatham's VBA after the
'Next' statement. It seems to do what I want with the formatting.
Not sure if there's a cleaner way.

'/* dman
' format stuff
DestSh.UsedRange.Select
With Selection
.Columns.WrapText = False
.Columns.AutoFit
.Interior.ColorIndex = xlNone 'unformat
Application.CutCopyMode = False
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=MOD(ROW(),2)"
.FormatConditions(1).Interior.ColorIndex = 24
End With

DestSh.Range("A1:F2").Select
With Selection
.Hyperlinks.Delete
.FormatConditions.Delete
.Interior.ColorIndex = 37
.HorizontalAlignment = xlCenter

.Font.FontStyle = "Bold"
.Font.ColorIndex = 11
End With
Range("F1:F2").Columns.AutoFit
'dman */

Now I'm going to figure out looking for value "Canceled" in Column
A and deleting those rows. Help with this would also be much
appreciated.

Dallman

---------------------------------------------------------------------
For the first request, copying from row 2 on first sheet, row 4
for the rest:

Add this to the variable declarations:
Dim sRow as Integer

then somewhere before the beginning of the For Each sh... loop
add this statement:
sRow = 2

Change the line that really does the work ( sh.Range(sh.Rows(2))...
to use sRow instead of 2:
sh.Range(sh.Rows(sRow))....
and right below that line of code add:
sRow=4

The first time the loop is run it will copy from row 2, and
after that it will always copy from row 4.
The code below includes those changes, plus it adds a test
within the loop to see if A4 is empty, and if it is empty,
the copy is not performed. Your 3rd request, not to copy
individual rows if they contain the word "Canceled" in column
A is a little more difficult since Ron's code (and even mine)
is copying a large area based on a start and end point and
without regard to what's in between. Probably best to add
another routine to go to the MergeSheet and delete rows that
have Canceled in column A after all of the work performed by
the loop in this code is finished. Here's my modification to
your displayed code
Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim sRow As Integer ' jlatham

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
If Not IsEmpty(sh.Range("A4")) Then 'jlatham
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(sRow), sh.Rows(shLast)).Copy _
DestSh.Cells(Last + 1, "A")
sRow = 4 ' jlatham
End If ' jlatham
End If
Next

Application.Goto DestSh.Cells(1)

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


JLatham

Combining multiple sheets
 
Not knowing how things are formatted up before you do the copies, I'd say
what you have is probably as good as anything else, with the point being that
it ends up formatted as you require.

The missing line of code was a test, you passed <g. Sorry about that.

Here's a routine you could add in the same module with what you have and
then call right after the Next that ends the copying routine and before the
formatting code you've added to deal with the entries with Canceled in column
A. I've set it up to start removing rows at row 3, since rows 1 and 2 are
header information you probably want to keep. I have made it Private to keep
it out of the list of available macros to be run from the Tools | Macro |
Macros feature. Just add this line of code after the Next statement in your
existing code from Ron's site:

RemoveCanceledEntries
Application.ScreenUpdating = False

I added the Application.ScreenUpdating = False statement because exiting the
RemoveCanceledEntries routine will reset it to True and this will keep things
going smoothly without eating up time refreshing the display while you do
your formatting.

Here's the code:

Private Sub RemoveCanceledEntries()
Dim rOffset As Long
Dim baseCell As Range

Set baseCell = Worksheets("MergeSheet").Range("A3")
Application.ScreenUpdating = False
Do Until IsEmpty(Range("A3").Offset(rOffset, 0))
'spelling must be same and in UPPERCASE here
If UCase(Trim(baseCell.Offset(rOffset, 0))) = "CANCELED" Then
baseCell.Offset(rOffset, 0).EntireRow.Delete
rOffset = rOffset - 1 ' stay here
End If
rOffset = rOffset + 1
Loop
End Sub

Hope this helps and is less frustrating than my first offering.

"Dallman Ross" wrote:

In , Dallman Ross <dman@localhost.
spake thusly:

Another thing is, I want to drop the formatting when I copy.
(Then I'll add formatting latter in an add-on macro.) How
can I do that?


Okay, I've stuck this near the end of Ron's/JLatham's VBA after the
'Next' statement. It seems to do what I want with the formatting.
Not sure if there's a cleaner way.


DestSh.UsedRange.Columns.WrapText = False 'dman
DestSh.UsedRange.Columns.AutoFit 'dman

'/* dman
' formatting stuff
DestSh.UsedRange.Select
Selection.Interior.ColorIndex = xlNone 'unformat
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(ROW(),2)"
Selection.FormatConditions(1).Interior.ColorIndex = 24
DestSh.Range("A1", "F2").Select
Selection.FormatConditions.Delete
Selection.Interior.ColorIndex = 37
'dman */

Now I'm going to figure out looking for

Dallman

---------------------------------------------------------------------
For the first request, copying from row 2 on first sheet, row 4
for the rest:

Add this to the variable declarations:
Dim sRow as Integer

then somewhere before the beginning of the For Each sh... loop
add this statement:
sRow = 2

Change the line that really does the work ( sh.Range(sh.Rows(2))...
to use sRow instead of 2:
sh.Range(sh.Rows(sRow))....
and right below that line of code add:
sRow=4

The first time the loop is run it will copy from row 2, and
after that it will always copy from row 4.
The code below includes those changes, plus it adds a test
within the loop to see if A4 is empty, and if it is empty,
the copy is not performed. Your 3rd request, not to copy
individual rows if they contain the word "Canceled" in column
A is a little more difficult since Ron's code (and even mine)
is copying a large area based on a start and end point and
without regard to what's in between. Probably best to add
another routine to go to the MergeSheet and delete rows that
have Canceled in column A after all of the work performed by
the loop in this code is finished. Here's my modification to
your displayed code
Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim sRow As Integer ' jlatham

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

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

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
If Not IsEmpty(sh.Range("A4")) Then 'jlatham
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(sRow), sh.Rows(shLast)).Copy _
DestSh.Cells(Last + 1, "A")
sRow = 4 ' jlatham
End If ' jlatham
End If
Next

Application.Goto DestSh.Cells(1)

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



Dallman Ross

Combining multiple sheets
 
In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

The missing line of code was a test, you passed <g. Sorry about
that.


:-)

Here's a routine you could add in the same module with what you
have and then call right after the Next that ends the copying
routine and before the formatting code you've added to deal with
the entries with Canceled in column A.


Very interesting. I learned a couple of things, including about
private macros; I hadn't known how they worked. I am keeping
your code around to refer to for more learning. I have
one question about it so far: the word that is in the rows
I want to delete in Column A is cased as follows: "Cancel".
So I'd have to take the uppercase directive out or change it.

Also, the trim thing is a nice touch and I appreciated seeing it.
It doesn't seem necessary in the particular instance of this data,
but it's still good for me to know.

Now I have to confess something, but I hope you won't feel like
your help was in vain, because it certainly wasn't. But while
I was waiting and hoping for more help I looked around on the
web and I found, e.g., this:

http://www.mvps.org/dmcritchie/excel/delempty.htm

Down low on that page he has this section:

Delete rows with "N" in Column 31 (#Delete_N_MarkedRows)

Sub Delete_N_MarkedRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lastrow As Long, r As Long
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = lastrow To 1 Step -1
If UCase(Cells(r, 31).Value) = "N" Then Rows(r).Delete
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

I thought, "Hey, I bet I can alter that for my needs." I see he
uses the UCase thing as you have, too. Anyway, I thought about
it and realized we are done with the main loop of the macro and I
still have your "sRow" integer sitting around, so I don't even need
another variable. I decided I could just stick a new For-loop in
front of the other (formatting) stuff I'm doing post-copy. I
removed the UCase, but I don't know how to specify case-sensitive
for "Cancel"; but in this case there is not going to be anything
similar there anyway. (I'd still like to know how to specify case,
though.)

Anyway, here's what I have now after the Next-statement in
the main macro. this deletion stuff and all the formatting
have gone in this section.

'/* dman
' delete rows with "Canceled" in Col A
For sRow = lastRow(DestSh) To 1 Step -1
If Cells(sRow, 1).Value = "Canceled" _
Then Rows(sRow).Delete
Next sRow

' format stuff
DestSh.UsedRange.Select
With Selection
.Columns.WrapText = False
.Columns.AutoFit
.Interior.ColorIndex = xlNone 'unformat
Application.CutCopyMode = False
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=MOD(ROW(),2)"
.FormatConditions(1).Interior.ColorIndex = 24
End With

DestSh.Range("A1:F2").Select
With Selection
.Hyperlinks.Delete
.FormatConditions.Delete
.Interior.ColorIndex = 37
.HorizontalAlignment = xlCenter

.Font.FontStyle = "Bold"
.Font.ColorIndex = 11
End With
Range("F1:F2").Columns.AutoFit
'dman */

Well, I don't know, stylistically, just how kosher that is,
but it works!

And with your help, the learning curve has been fun so far.


My next task will be to take Column C's data and run it
through Text-to-Columns, adding several columns. I'll have
to insert some blank columns after C first to keep data
in remaining columns from being overwritten. Then I'll
have to get the column widths right again.

Here is an example of what's in Column C. You'll see
why I want to separate the words.

Buy 100 AMD Limit 14.25 GTC DNR

Actually, the "GTC DNR" ("Do Not Reduce") part could
be in a single column, but it's more trouble than it's
worth to do that while separating all the other words
via Text-to-Columns.

Dallman

===================================
In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

Not knowing how things are formatted up before you do the
copies, I'd say what you have is probably as good as anything
else, with the point being that it ends up formatted as you
require.

The missing line of code was a test, you passed <g. Sorry about
that.

Here's a routine you could add in the same module with what you
have and then call right after the Next that ends the copying
routine and before the formatting code you've added to deal with
the entries with Canceled in column A. I've set it up to start
removing rows at row 3, since rows 1 and 2 are header information
you probably want to keep. I have made it Private to keep it
out of the list of available macros to be run from the Tools |
Macro | Macros feature. Just add this line of code after the
Next statement in your existing code from Ron's site:

RemoveCanceledEntries
Application.ScreenUpdating = False

I added the Application.ScreenUpdating = False statement because
exiting the RemoveCanceledEntries routine will reset it to True
and this will keep things going smoothly without eating up time
refreshing the display while you do your formatting.

Here's the code:

Private Sub RemoveCanceledEntries()
Dim rOffset As Long
Dim baseCell As Range

Set baseCell = Worksheets("MergeSheet").Range("A3")
Application.ScreenUpdating = False
Do Until IsEmpty(Range("A3").Offset(rOffset, 0))
'spelling must be same and in UPPERCASE here
If UCase(Trim(baseCell.Offset(rOffset, 0))) = "CANCELED" Then
baseCell.Offset(rOffset, 0).EntireRow.Delete
rOffset = rOffset - 1 ' stay here
End If
rOffset = rOffset + 1
Loop
End Sub

Hope this helps and is less frustrating than my first offering.

"Dallman Ross" wrote:
[snip]


JLatham

Combining multiple sheets
 
When you want to compare to the exact case, just type it in the way it MUST
be in the cells. If you don't use LCase or UCase, then the comparison is
made as you've shown it in the code. Worksheet functions generally disregard
case, VB does not. That's why you'll often see L/Ucase used - so that the
programmer doesn't have to worry if someone typed Cancel or CANCEL or cancel
or some odd 'typo' variation such as CanCel. Another often used VB statement
in dealing with similar situations is Trim() which removes leading and
trailing 'white space' in a string, so that if someone accidentally typed
"Cancel " or " Cancel" then the comparison will be done properly when they
compare to "Cancel"

For much of your remaining work, I think recording macros and looking at the
code they generate and modifying it as needed for flexibility, looping, etc.
should work well for you. But we're here if it doesn't.

"Dallman Ross" wrote:

In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

The missing line of code was a test, you passed <g. Sorry about
that.


:-)

Here's a routine you could add in the same module with what you
have and then call right after the Next that ends the copying
routine and before the formatting code you've added to deal with
the entries with Canceled in column A.


Very interesting. I learned a couple of things, including about
private macros; I hadn't known how they worked. I am keeping
your code around to refer to for more learning. I have
one question about it so far: the word that is in the rows
I want to delete in Column A is cased as follows: "Cancel".
So I'd have to take the uppercase directive out or change it.

Also, the trim thing is a nice touch and I appreciated seeing it.
It doesn't seem necessary in the particular instance of this data,
but it's still good for me to know.

Now I have to confess something, but I hope you won't feel like
your help was in vain, because it certainly wasn't. But while
I was waiting and hoping for more help I looked around on the
web and I found, e.g., this:

http://www.mvps.org/dmcritchie/excel/delempty.htm

Down low on that page he has this section:

Delete rows with "N" in Column 31 (#Delete_N_MarkedRows)

Sub Delete_N_MarkedRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lastrow As Long, r As Long
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = lastrow To 1 Step -1
If UCase(Cells(r, 31).Value) = "N" Then Rows(r).Delete
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

I thought, "Hey, I bet I can alter that for my needs." I see he
uses the UCase thing as you have, too. Anyway, I thought about
it and realized we are done with the main loop of the macro and I
still have your "sRow" integer sitting around, so I don't even need
another variable. I decided I could just stick a new For-loop in
front of the other (formatting) stuff I'm doing post-copy. I
removed the UCase, but I don't know how to specify case-sensitive
for "Cancel"; but in this case there is not going to be anything
similar there anyway. (I'd still like to know how to specify case,
though.)

Anyway, here's what I have now after the Next-statement in
the main macro. this deletion stuff and all the formatting
have gone in this section.

'/* dman
' delete rows with "Canceled" in Col A
For sRow = lastRow(DestSh) To 1 Step -1
If Cells(sRow, 1).Value = "Canceled" _
Then Rows(sRow).Delete
Next sRow

' format stuff
DestSh.UsedRange.Select
With Selection
.Columns.WrapText = False
.Columns.AutoFit
.Interior.ColorIndex = xlNone 'unformat
Application.CutCopyMode = False
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=MOD(ROW(),2)"
.FormatConditions(1).Interior.ColorIndex = 24
End With

DestSh.Range("A1:F2").Select
With Selection
.Hyperlinks.Delete
.FormatConditions.Delete
.Interior.ColorIndex = 37
.HorizontalAlignment = xlCenter

.Font.FontStyle = "Bold"
.Font.ColorIndex = 11
End With
Range("F1:F2").Columns.AutoFit
'dman */

Well, I don't know, stylistically, just how kosher that is,
but it works!

And with your help, the learning curve has been fun so far.


My next task will be to take Column C's data and run it
through Text-to-Columns, adding several columns. I'll have
to insert some blank columns after C first to keep data
in remaining columns from being overwritten. Then I'll
have to get the column widths right again.

Here is an example of what's in Column C. You'll see
why I want to separate the words.

Buy 100 AMD Limit 14.25 GTC DNR

Actually, the "GTC DNR" ("Do Not Reduce") part could
be in a single column, but it's more trouble than it's
worth to do that while separating all the other words
via Text-to-Columns.

Dallman

===================================
In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

Not knowing how things are formatted up before you do the
copies, I'd say what you have is probably as good as anything
else, with the point being that it ends up formatted as you
require.

The missing line of code was a test, you passed <g. Sorry about
that.

Here's a routine you could add in the same module with what you
have and then call right after the Next that ends the copying
routine and before the formatting code you've added to deal with
the entries with Canceled in column A. I've set it up to start
removing rows at row 3, since rows 1 and 2 are header information
you probably want to keep. I have made it Private to keep it
out of the list of available macros to be run from the Tools |
Macro | Macros feature. Just add this line of code after the
Next statement in your existing code from Ron's site:

RemoveCanceledEntries
Application.ScreenUpdating = False

I added the Application.ScreenUpdating = False statement because
exiting the RemoveCanceledEntries routine will reset it to True
and this will keep things going smoothly without eating up time
refreshing the display while you do your formatting.

Here's the code:

Private Sub RemoveCanceledEntries()
Dim rOffset As Long
Dim baseCell As Range

Set baseCell = Worksheets("MergeSheet").Range("A3")
Application.ScreenUpdating = False
Do Until IsEmpty(Range("A3").Offset(rOffset, 0))
'spelling must be same and in UPPERCASE here
If UCase(Trim(baseCell.Offset(rOffset, 0))) = "CANCELED" Then
baseCell.Offset(rOffset, 0).EntireRow.Delete
rOffset = rOffset - 1 ' stay here
End If
rOffset = rOffset + 1
Loop
End Sub

Hope this helps and is less frustrating than my first offering.

"Dallman Ross" wrote:
[snip]



Dallman Ross

Combining multiple sheets
 
In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

When you want to compare to the exact case, just type it in
the way it MUST be in the cells. If you don't use LCase or
UCase, then the comparison is made as you've shown it in the
code. Worksheet functions generally disregard case, VB does not.


Great to know.

For much of your remaining work, I think recording macros and
looking at the code they generate and modifying it as needed for
flexibility, looping, etc. should work well for you. But we're
here if it doesn't.


Yup, I've been doing that an awful lot. :-)

A question that I have now is: I thought maybe I'd take all that
formatting stuff of mine out of what was originally Ron de Bruin's
VBA code as edited a bit by you and me. I'd put it in a "submacro"
(private, I suppose) that I call from the main merge macro.
However, I don't want to have to restate all the DIM statements,
etc. Moreover, I want to be able to use the existing states
and settings, such as Lastrow, DestSh, UsedRange, etc., that
Ron bothered to set up. So now I don't know how to do that -- if
it can be done: call a subroutine that remembers vars and states.

Thanks again for your great help!

Dallman

JLatham

Combining multiple sheets
 
What you can do with the variables/Constants that are to be shared within a
given code module is move their declarations out from within the Sub
declaration(s) and put them above the first Sub or Function declaration in
that code module. Remove their declarations (Dim/Const) within the
Sub/Functions because if you leave them there, then they become different
variables/constants but with the same name and the Sub/Function will work
with the ones declared within it rather than the ones that were declared
outside of them. If this seems strange or unclear, do some searching around
for 'Scope' as it relates to variables and constants.

What happens then is that they become visible to all Subs/Functions within
that code module. Just remember that any change made to any of them by any
function or sub in the module remains with them - they don't start over fresh
with each call to a sub/funtion. This means you may need to initialize some
to a known state at the start of a called function/sub or if that
sub/function changes them but the calling routine needs to use them with
their pre-call values, then you have to deal with that. But things like
Lastrow, DestSh, UsedRange should only be getting set one time somewhere, so
that shouldn't be an issue.

"Dallman Ross" wrote:

In , JLatham
<HelpFrom @ jlathamsite.com.(removethis) spake thusly:

When you want to compare to the exact case, just type it in
the way it MUST be in the cells. If you don't use LCase or
UCase, then the comparison is made as you've shown it in the
code. Worksheet functions generally disregard case, VB does not.


Great to know.

For much of your remaining work, I think recording macros and
looking at the code they generate and modifying it as needed for
flexibility, looping, etc. should work well for you. But we're
here if it doesn't.


Yup, I've been doing that an awful lot. :-)

A question that I have now is: I thought maybe I'd take all that
formatting stuff of mine out of what was originally Ron de Bruin's
VBA code as edited a bit by you and me. I'd put it in a "submacro"
(private, I suppose) that I call from the main merge macro.
However, I don't want to have to restate all the DIM statements,
etc. Moreover, I want to be able to use the existing states
and settings, such as Lastrow, DestSh, UsedRange, etc., that
Ron bothered to set up. So now I don't know how to do that -- if
it can be done: call a subroutine that remembers vars and states.

Thanks again for your great help!

Dallman



All times are GMT +1. The time now is 04:28 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com