Report Bursting in Excel 2000? 1

[MSIsam]

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

 

[MSIsam]

Thanks Skip for all your help. It's much appreciated. The only issue now is that the file name is only using the first value in the list of values to be looped and it keeps asking me if I want to replace the file? Is the SaveAs function incorporated in the loop?
Sam

 

[SkipVought]

I don't understand.

Please post your code.

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

 

[MSIsam]

Here it is:

Sub burst_final()

    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_" & r.Value & "_REPORT.xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            .Close
        End With
    Next
End Sub

When I run this, I get the following message over and over:
A file named 'C:\GATCFBurst\DIV_4667_REPORT' already exists in this location. Do you want to replace it?

Looks like it is not selecting the next value in the SaveAs part.

 

[SkipVought]

What values do you nave in your column?

If that file has already been saved, naturally, it will be there.

Do you have an existing file...
C:\GATCFBurst\DIV_4667_REPORT???

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

 

[MSIsam]

the first dinstinct value is 4667, then it pretty much is sequential after that. The problem is that the first file is saved correctly as DIV_4667_REPORT, then it keeps repeating the same step trying to save the same DIV_4667_REPORT. It is not looping.
Sam

 

[SkipVought]

if 4667 is in A2, what value is in A3?

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

 

[KenWright]

Skip - just guessing but I'm reckoning on:-

A
1 Div
2 4667
3 4667
4 4667
5 4668
6 4668
7 4669
8 4610
9 4610
etc

so assume Op is looking for breaks on the distinct values, eg

1 Div
2 4667 <<<<
3 4667
4 4667
5 4668 <<<<
6 4668
7 4669 <<<<
8 4610 <<<<
9 4610
etc

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


----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------

 

[MSIsam]

That's correct Ken.

 

[SkipVought]

So then you have to TEST the r.Value to determine when it changes...

Sub burst_final()

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

    Set wsThis = ActiveSheet
    Dim rngA As Range, r As Range
    Set rngA = Range([A2], [A2].End(xlDown))
    nPrev = 0
    For Each r In rngA.SpecialCells(xlCellTypeVisible)
      if r.value <> nPrev then
        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_" & r.Value & "_REPORT.xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            .Close
        End With
      end if
      nPrev = r.value
    Next
End Sub

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

 

[SkipVought]

Ken, I'm ready to the weekend!

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

 

[MSIsam]

Brilliant! Thanks so much Skip and Ken.

Skip,
Your technical prowess is only matched by your patience!

 

[KenWright]

I was ready for that at 9am on Monday

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------

 

[SkipVought]

Ken, take the rest of the week of, mate!

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