Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
I have a spreadsheet that has been subtotaled. The formula in the subtotal
cell is “=subtotal(3,j2:j61)” . Is there a way ,Using this information from the subtotal formula, which is the number of rows with each client's info. I would like to run a macro to copy the data from cells a2:q61 to a new worksheet named with contents of cell “I”. This process needs to repeat down thru aprox 6500 rows that have all been subtotaled down to 1500 separate lines . |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
Try this code. The code copies rows so it doesn't care the number of columns. All it looks at is column A to get the Client Name and looks for the word "Total" in column A to determine where each subtotal ends. Sub SplitSubtotal() 'assume there is a header row which gets copied to each new sheet Set Sourcesht = Sheets("Sheet1") With Sourcesht LastRow = .Range("A" & Rows.Count).End(xlUp).Row 'ignore the Grand Total line if one exists If InStr(UCase(.Range("A" & LastRow)), "GRAND") 0 Then LastRow = LastRow - 1 End If StartRow = 2 RowCount = StartRow For RowCount = StartRow To LastRow If InStr(UCase(.Range("A" & RowCount)), "TOTAL") 0 Then client = .Range("A" & StartRow) 'create new sheet Set newsht = Sheets.Add(after:=Sheets(Sheets.Count)) 'changge sheet name to clients name newsht.Name = client 'copy header row .Rows(1).Copy Destination:=newsht.Rows(1) 'copy data .Rows(StartRow & ":" & RowCount).Copy _ Destination:=newsht.Rows(2) StartRow = RowCount + 1 End If Next RowCount End With End Sub -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510 http://www.thecodecage.com/forumz |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
Thank you Joel with a few modifications it went thru my whole list. If I
wished to copy each list to a seperate workbook in h:\clients\ rather than seperate sheet. Thanks Again JC |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
The code below I didn't test but is very similar to the older macro. You should be able to get it working like the last macro Sub SplitSubtotal() Folder = "h:\clients\" 'assume there is a header row which gets copied to each new sheet Set Sourcesht = ThisWorkbook.Sheets("Sheet1") With Sourcesht LastRow = .Range("A" & Rows.Count).End(xlUp).Row 'ignore the Grand Total line if one exists If InStr(UCase(.Range("A" & LastRow)), "GRAND") 0 Then LastRow = LastRow - 1 End If StartRow = 2 RowCount = StartRow For RowCount = StartRow To LastRow If InStr(UCase(.Range("A" & RowCount)), "TOTAL") 0 Then client = .Range("A" & StartRow) 'create new workbook Set Newbook = Workbooks.Add(template:=xlWBATWorksheet) Set newsht = Newbook.Sheets(1) 'change sheet name to clients name newsht.Name = client 'copy header row .Rows(1).Copy Destination:=newsht.Rows(1) 'copy data .Rows(StartRow & ":" & RowCount).Copy _ Destination:=newsht.Rows(2) StartRow = RowCount + 1 Newbook.SaveAs Filename:=Folder & client Newbook.Close savechanges:=True End If Next RowCount End With End Sub -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510 http://www.thecodecage.com/forumz |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
This is FANTASTIC!!!!!!!!!!!!!!!!!!!!!!
3 beers for Joel!!! 1 item I cant code is to expand the subtotaled data in the new workbooks. I need to go to each sheet and click the + in the outline column. I have tried all of the following ReturnCurrentOutlineLevel = 2 'Most Detailed 'Sheet.Outline.ShowLevels RowLevels:=2, columnlevels:=2 'Application.Outline.ShowLevels RowLevels:=2, columnlevels:=2 I tried recording a macro to expand and nothing records. Thanks again JC |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
The workbook created didn't havve macros enabled Try this from Set Newbook = Workbooks.Add(template:=xlWBATWorksheet) to Set Newbook = Workbooks.Add(template:=xlWBATExcel4IntlMacroSheet ) Or from Newbook.SaveAs Filename:=Folder & client to Newbook.SaveAs Filename:=Folder & client, FileFormat:=xlExcel12 -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510 http://www.thecodecage.com/forumz |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
I am not running the macros from the new workbooks I have a workbook called
MyMacros I store most macros in. Will changing this to macro enabled workbook allow the subtotals to be expanded from a macro ran from a different workbook. All the code you helped with works great , just the new workbooks have coppied the data from the original workbook and left it compressed subtotal. Hence the new workbook has just 1 visible row until the subtotal "+" in the far left column is expanded. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
I tried to record a macro to expand the subtotals and no code was recorded. Wouldn't it be simplier to just expand the subtotals once before you run the macro? -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510 http://www.thecodecage.com/forumz |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
That worked no problem.
Thanks Joel JC |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
Joel, Your code worked great last month , This month I get an "error 13 TypeMismatch" when I try to run my macro. here is my code the error occurs at "If InStr(UCase(.Range("b" & RowCount)), "Total") 0 Then" '*********NOTE ADD "TOTAL" TO COLUMN "A" BEFORE EXPANDING AND RUNNING THIS MACRO********************** 'ADDITIONAL NOTES CECK COLUMN FOR CONTRACTOR AND COUNT , ELIMINATE ILLEGAL CHARACTERS IN CONTRACTOR NAMES BEFORE RUNNING 'change directory Folder = "h:\Contractor Expired\Contractor Expired Apr2010\" 'Folder = "\\dpd-sharepoint\electrical\Contractor Expired Spreadsheets\April2010" 'assume there is a header row which gets copied to each new sheet Set Sourcesht = ThisWorkbook.Sheets("Expired") With Sourcesht LastRow = .Range("h" & Rows.Count).End(xlUp).Row 'ignore the Grand Total line if one exists If InStr(UCase(.Range("h" & LastRow)), "GRAND") 0 Then LastRow = LastRow - 1 End If Application.ScreenUpdating = False StartRow = 2 RowCount = StartRow For RowCount = StartRow To LastRow ' Application.IsError (CellValue) If InStr(UCase(.Range("b" & RowCount)), "Total") 0 Then client = .Range("H" & StartRow) 'create new workbook Set newbook = Workbooks.Add(template:=xlWBATWorksheet) Set newsht = newbook.Sheets(1) 'change sheet name to clients name newsht.Name = client 'copy header row .Rows(1).Copy Destination:=newsht.Rows(1) 'copy data .Rows(StartRow & ":" & RowCount).Copy _ Destination:=newsht.Rows(2) StartRow = RowCount + 1 'newbook.Active newbook.SaveAs Filename:=Folder & client FormatContractorList 'macro that hides some columns in new WB newbook.Close savechanges:=True End If Next RowCount End With End Sub Thank You again for your help Duane joel;693000 Wrote: The code below I didn't test but is very similar to the older macro. You should be able to get it working like the last macro Sub SplitSubtotal() Folder = "h:\clients\" 'assume there is a header row which gets copied to each new sheet Set Sourcesht = ThisWorkbook.Sheets("Sheet1") With Sourcesht LastRow = .Range("A" & Rows.Count).End(xlUp).Row 'ignore the Grand Total line if one exists If InStr(UCase(.Range("A" & LastRow)), "GRAND") 0 Then LastRow = LastRow - 1 End If StartRow = 2 RowCount = StartRow For RowCount = StartRow To LastRow If InStr(UCase(.Range("A" & RowCount)), "TOTAL") 0 Then client = .Range("A" & StartRow) 'create new workbook Set Newbook = Workbooks.Add(template:=xlWBATWorksheet) Set newsht = Newbook.Sheets(1) 'change sheet name to clients name newsht.Name = client 'copy header row .Rows(1).Copy Destination:=newsht.Rows(1) 'copy data .Rows(StartRow & ":" & RowCount).Copy _ Destination:=newsht.Rows(2) StartRow = RowCount + 1 Newbook.SaveAs Filename:=Folder & client Newbook.Close savechanges:=True End If Next RowCount End With End Sub -- Duane ------------------------------------------------------------------------ Duane's Profile: http://www.thecodecage.com/forumz/member.php?u=1891 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510 http://www.thecodecage.com/forumz |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy subtotaled data
The only reason I can see for the instruction to give an error is if you had a formula in column b that produced an Error. Se if this change help you find the problem 'from For RowCount = StartRow To LastRow ' Application.IsError (CellValue) If InStr(UCase(.Range("b" & RowCount)), "Total") 0 Then 'To For RowCount = StartRow To LastRow If WorksheetFunction.IsError("Expired!B" & RowCount)) Then MsgBox ("Error in Cell : B" & RowCount & vbCrLf & _ "Exiting Macro") Exit Sub End If ' Application.IsError (CellValue) If InStr(UCase(.Range("b" & RowCount)), "Total") 0 Then -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510 http://www.thecodecage.com/forumz |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I copy subtotaled data without underlying details in Excel | Excel Worksheet Functions | |||
Using Subtotaled Data | Excel Worksheet Functions | |||
subtotaled spreadsheet? | Charts and Charting in Excel | |||
individual tabs for subtotaled data | Excel Discussion (Misc queries) | |||
How do I copy subtotaled data without the underlying details? | Excel Worksheet Functions |