![]() |
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 |
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 |
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 |
Combining multiple sheets
In , Peo Sjoblom
spake thusly: http://www.rondebruin.nl/summary.htm Excellent stuff there. Thanks. I'm trying it out. Dallman |
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. |
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 |
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 |
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] |
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 |
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 |
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 |
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] |
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] |
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 |
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