Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Report Bursting in Excel 2000? 1

Status
Not open for further replies.
MSIsam

MSIsam

Programmer
Sep 29, 2003
173
US
I have a data dump that I put into Excel and I need to burst out into multiple xls workbooks based on the the grouping of the first column. Basically, the report has all accounts in a national level and needs to be parsed into multiple workbooks by division (Division is the first column in the spreadsheet). Is there an easy way to do this, including naming the workbook with the division number?
Thanks for any help on this,
Sam
 
Sort by date Sort by votes
Sam,

It's usually a real bad disign to segment data into separate worksheets or workbooks.

What are you trying to accomplish by chopping up your data?

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
Thanks for you reply Skip,
I agree that this is not the ideal way. The data in the spreadsheets needs to be distributed to the heads of each division and due to security reasons, they should not see the data from the other divisions. This is temporary until we adopt our Bi solution to handle rpeort bursting and/or administrate using row level database security.
I have a SQL statement that I run and paste the results into the spreadsheet. Then I manually chop the data into individual spreadsheets for distribution.
 
Upvote 0 Downvote
Subject to Skip's request for more detail, on what you have posted so far, if you really want to do that then I would possibly suggest a Pivot table initially, get the data into an acceptable report format, throw the division into the page fields, use the 'show pages' option in the Pivot table to automatically generate a sheet with that report for every division and then use code to mail out every sheet to it's appropriate analyst.

Regards
Ken.............

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]
----------------------------------------------------------------------------
 
Upvote 0 Downvote
Sam,

Check out Ron de Bruin's site:
I use 2 burst subs to quickly burst an Excel export from Crystal Reports - when that's faster then creating separate exports to Excel (say one for each country in the world).

Ilse
 
Upvote 0 Downvote
I Assume that you have a row of headings

Turn on the AutoFilter

Add a New Sheet

Looping thru each value in column A...

Filter on the Value

Copy the visible cells

Paste in the new worksheet

eMail the sheet to recipient

Clear Cells on New Sheet

Next

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
Thanks Everyone for your input. I think that I may have not explained myself well enough. The solution that Skip provided will work, but is failry labor intensive since I will have to create about 50 spreadsheets. What I am looking for is a Macro to automate this routine when the source data gets dumped into a single tab on a workbook.
Code: 
Division  Atribute1  Attrubute2  Attribute3
      10    ABCDEFG     ABCDEFG     ABCDEFG
      10    ABCDEFG     ABCDEFG     ABCDEFG
      10    ABCDEFG     ABCDEFG     ABCDEFG
      20    ABCDEFG     ABCDEFG     ABCDEFG
      20    ABCDEFG     ABCDEFG     ABCDEFG
In this example, I would run the macro and get 2 separate workbooks named something like
"DIV_10_DATA.xls" - containing the header and first 3 rows
and
"DIV_20_DATA.xls" - containing the header and last 2 rows

I know that there are better solutions out there but I am not in control of how the data gets into the sreadsheet, only how the data need to be in the final result (Separate spreadsheets).
 
Upvote 0 Downvote
It's not labor intensive at all, unless you count writing the vb code.

I suggest that you macro record the process as outlined above (naturally, without the loop), post your recorded code and we'll help you loop it 50 times.

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
And just so you understand why - by doing it once and recording the macro as you go, we get to see the real ranges, and can then just give you the tweaks you need to put into your existing code without guessing what it is you're filtering on etc.

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]
----------------------------------------------------------------------------
 
Upvote 0 Downvote
OK, Here is the code from my recorded Macro. I went through the steps 2 times to create 2 files.

Code: 
Sub burst2()
[COLOR=green]'
' burst2 Macro
' Macro recorded 3/15/2005 by Sam Darin
'

'
'This needs to loop through all values in the column[/color]
    Selection.AutoFilter Field:=1, Criteria1:="6446"
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Application.CutCopyMode = False
    ChDir "C:\GATCFBurst"
[COLOR=green]'The XXXXX in the file name needs to be dynamic and be
'equal to the value of the filter criteria selected[/color]
    ActiveWorkbook.SaveAs Filename:="C:\GATCFBurst\DIV_XXXXX_REPORT.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Selection.AutoFilter Field:=1, Criteria1:="6447"
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\GATCFBurst\DIV_ZZZZZ_REPORT.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
End Sub
Thanks!
Sam
 
Upvote 0 Downvote
Code: 
Sub burst2()
    Dim rng1 As Range, wsThis As Worksheet, wbNew As Workbook, i, sCrit, sFname
'This needs to loop through all values in the column

'in WHAT column?????

    Set wsThis = ActiveSheet
    For i = 1 To 2
    'i don't know where you're getting these values from?????????
        Select Case i
            Case 1
                sCrit = "6446"
                sFname = "XXXX"
            Case 2
                sCrit = "6447"
                sFname = "ZZZZ"
        End Select
        With wsThis
            .Range("A1").AutoFilter Field:=1, Criteria1:=sCrit
            Set rng1 = Range(.[A1], .[A1].End(xlToRight))
            Range(rng1, rng1.End(xlDown)).Copy
        End With
        Set wbNew = Workbooks.Add
        ActiveSheet.Paste
        Cells.EntireColumn.AutoFit
        Application.CutCopyMode = False
    
    'The XXXXX in the file name needs to be dynamic and be
    'equal to the value of the filter criteria selected
        With wbNew
            .SaveAs Filename:="C:\GATCFBurst\DIV_" & sFname & "_REPORT.xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            .Close
        End With
    Next
End Sub

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
Thanks Skip,
Clarifications:
'This needs to loop through all values in the column
'in WHAT column?????
I placed an autofilter on columnA, this is the column that is driving the way the files are parsed.
'i don't know where you're getting these values from?????????
The 6446 is the first distinct value in the column, 6447 is the second distinct value. This is where the looping must happen.
So the number of distinct values in this list will be the total number of files created by the macro.
The XXXX and ZZZZ in the filenames are just place holders for the actual column values in column A (6446, 6447, etc.)
 
Upvote 0 Downvote
Assuming that A1 is a heading and A2 is the first data cell and your table is contiguous...
Code: 
dim rngA as range, r as range
set rngA = range([A2], [A2].end(xldown))
for each r in rngA.SpecialCells(xlcellsvisible)
  ....

        With wsThis
            .Range("A1").AutoFilter Field:=1, Criteria1:=[b]r.value[/b]
            Set rng1 = Range(.[A1], .[A1].End(xlToRight))
            Range(rng1, rng1.End(xlDown)).Copy
        End With
   

  ....
next
and make a similar substitution in the saveas

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
I apologize for my lack of VB skill (none), but where does this code go?
 
Upvote 0 Downvote
I had given you a previous example of code on 15 Mar 05 20:07. It will go in there -- word for word EXCEPT for the NEW substitution and the OTHER substitution that you will need to make.

Replace For i = 1 to 2 with the first 3 lines of code.

Line 1 declares the variables

Line 2 set the range object for your loop

Line 3 is the first line of the loop

the With...End With can be copied and pasted over the existing With...End With. Make the necessary substitution in the SaveAs statement

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
As far as where to put the code Skip has given you, Try this step by step guide, and it can be applied to almost any macro you see:-

Hit ALT+F11 and this will open the VBE (Visual Basic Editor)
Top left you will hopefully see an explorer style pane. Within this pane you need to search for your workbook's name, and when you find it you may need to click on the + to expand it. Within that you should see the following:-

VBAProject(Your_Filename)
Microsoft Excel Objects
Sheet1(Sheet1)
Sheet2(Sheet2)
Sheet3(Sheet3)
ThisWorkbook

If you have named your sheets then those names will appear in the brackets above as opposed to what you see at the moment in my note.

Right click on the where it says VBAProject(Your_Filename) and choose 'Insert Module' and it will now look like this

VBAProject(Your_Filename)
Microsoft Excel Objects
Sheet1(Sheet1)
Sheet2(Sheet2)
Sheet3(Sheet3)
ThisWorkbook
Modules
Module1

Double click the Module1 bit and then paste in whatever code you have been given, starting with the Sub xyz() bit and finishing at the End Sub bit, eg:-

Sub xyz()

Dim ....blah blah blah
Dim ....blah blah blah
Code to do stuff

End Sub

Then hit File / Close and return to Microsoft Excel and save the file. Now just do Tools / Macro / Macros / xyz


If you then wanted to get rid of the macro for any reason, then do the following:-

Hit ALT+F11 and this will open the VBE (Visual Basic Editor)
Top left you will hopefully see an explorer style pane. Within this pane you need to search for your workbook's name, and when you find it you may need to click on the + to
expand it. Within that you should see the following:-

VBAProject(Your_Filename)
Microsoft Excel Objects
Sheet1(Sheet1)
Sheet2(Sheet2)
Sheet3(Sheet3)
etc..........................
ThisWorkbook
Modules
Module1

Right click on the Module1 and select remove. When prompted with a question re exporting, just hit no. Then hit File / Close and return to Microsoft Excel and save the file.

Regards
Ken................

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]
----------------------------------------------------------------------------
 
Upvote 0 Downvote
I got the following error:
Run-time error '1004':
Unable to get the SpecialCells property of the range class.

Code: 
Sub burst2()

    Dim rng1 As Range, wsThis As Worksheet, wbNew As Workbook, i, sCrit, sFname

    Set wsThis = ActiveSheet
    Dim rngA As Range, r As Range
    Set rngA = Range([A2], [A2].End(xlDown))
    For Each r In rngA.SpecialCells(xlcellsvisible)

       Select Case i
           Case 1
               sCrit = "6446"
               sFname = "XXXX"
           Case 2
               sCrit = "6447"
               sFname = "ZZZZ"
        End Select
        With wsThis
            .Range("A1").AutoFilter Field:=1, Criteria1:=r.Value
            Set rng1 = Range(.[A1], .[A1].End(xlToRight))
            Range(rng1, rng1.End(xlDown)).Copy
        End With

        Set wbNew = Workbooks.Add
        ActiveSheet.Paste
        Cells.EntireColumn.AutoFit
        Application.CutCopyMode = False
    
        With wbNew
            .SaveAs Filename:="C:\GATCFBurst\DIV_" & sFname & "_REPORT.xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            .Close
        End With
    Next
End Sub
 
Upvote 0 Downvote
sorry...

For Each r In rngA.SpecialCells(xlCellTypeVisible)

also you do not need the select case statement

Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
OK, we are very close (rather you are since you are doing all the work!)

This is now working but I am not sure what to put in the saveas part to place the number into the file name.
Code: 
Sub burst2()

    Dim rng1 As Range, wsThis As Worksheet, wbNew As Workbook, i, sCrit, sFname

    Set wsThis = ActiveSheet
    Dim rngA As Range, r As Range
    Set rngA = Range([A2], [A2].End(xlDown))
    For Each r In rngA.SpecialCells(xlCellTypeVisible)
        With wsThis
            .Range("A1").AutoFilter Field:=1, Criteria1:=r.Value
            Set rng1 = Range(.[A1], .[A1].End(xlToRight))
            Range(rng1, rng1.End(xlDown)).Copy
        End With

        Set wbNew = Workbooks.Add
        ActiveSheet.Paste
        Cells.EntireColumn.AutoFit
        Application.CutCopyMode = False
    
        With wbNew
            .SaveAs Filename:="C:\GATCFBurst\DIV_" & [b][COLOR=red]???[/color][/b] & "_REPORT.xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            .Close
        End With
    Next
End Sub
 
Upvote 0 Downvote
Code: 
        With wbNew
            .SaveAs Filename:="C:\GATCFBurst\DIV_" & r.value & "_REPORT.xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            .Close
        End With


Skip,
[sub]
[glasses] [red]Be advised:[/red] When you ignite a firecracker in a bowl of vanilla, chocolate & strawberry ice cream, you get...
Neopolitan Blownapart! [tongue][/sub]

 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

C
  • Locked
  • Question
Office 2000 XL
Replies
6
Views
518
dhookom
dhookom
Bijugate
  • Locked
  • Question
Excel update question
Replies
0
Views
281
Bijugate
Bijugate
Pirouette
  • Locked
  • Question
Excel workbook
Replies
1
Views
281
combo
combo
shytott
  • Locked
  • Question
Excel - Toggle Button Code 1
Replies
10
Views
849
shytott
shytott
renigar
  • Question
Excel Power Query refresh error
Replies
3
Views
604
SoftwareRT
SoftwareRT

Part and Inventory Search

Sponsor

Back
Top