asked on

Excel, Subdivide and Save

I have a Excel 2007 worksheet with data I want to subdivide by "Jurisdiction", then copy/paste each jurisdiction’s block of data into its own new workbook, in its own unique jurisdiction folder. I've already recorded a macro to sort and de-duplicate the records. I am stuck trying to auto copy/paste each jurisdiction block to unique workbook/folder.
Example file attached. I would like to add to my existing macro steps to auto copy/paste “Adair” data to …./Adair/Test.xls.
sample-data.xlsx

Rgonzo1971

HI,

This should do it

Sub DoIt()
Dim myRange As Range
Dim myRange2 As Range

Set myRange = Range(Range("A2"), Range("A65000").End(xlUp))
Set myRange2 = Range(Range("A1"), Range("B65000").End(xlUp))
Set MyDict = New Dictionary ' reference to MS Scripting runtime

Application.ScreenUpdating = False

For Each c In myRange
    If Not (MyDict.Exists(c)) Then
        MyDict.Add c, c
    End If
Next
    
    Range("A1:B1").AutoFilter
For Each Item In MyDict
    Range("A1:B1").AutoFilter Field:=1, Criteria1:=Item
    myRange2.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Range("A1").PasteSpecial Paste:=xlAll
    ActiveSheet.Range("A:B").PasteSpecial Paste:=8 ' xlColumnWidths isn't defined
    Application.CutCopyMode = False
    ActiveSheet.Copy
    ActiveSheet.SaveAs ("c:\" & Item & "\test.xls") ' Change for use/the folder should already exist
    ActiveWorkbook.Close
    Windows("sample-data.xlsx").Activate
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
Next

ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Open in new window

Regards

InfoChase

ASKER

Getting error on line 7. Set MyDict = New Dictionary ' reference to MS Scripting runtime

Compile error: User-definid type not defined.

Ken Butters

Within the VBA project explorer you need to go to

Tools... then References.

Then scroll down and locate "Microsoft Scripting Runtime" and make sure it is checked. Then Hit OK.

That reference has all the info that VBA needs in order to understand what a Dictionary is.

See attached Screenshot for an example of what it should look like.
Screenshot.jpg

InfoChase

ASKER

That helped get a little further down the line. Now getting error:

Run-time error "9";
Subscript out of range

When I debug it highlights line 26 (note I added my pathname I:\:
ActiveSheet.SaveAs ("I:\CP\BE\CL\CLMR\Monthly report\" & Item & "\test.xlsx") '

Code works fine on the 1st iteration, but errors after sorting and copying the file to the first item folder ADAIR.

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

InfoChase

ASKER

I changed " & Item & " in Line 27 to " & MyItem & " and it worked! Thanks!