Solved: Create Multiple Sheets and Save As CSV (COMMA DILIMITED) FORMAT

[hardeep]

Hi! Experts
Is it Possible!
I have an Excel 2007 Sheet with data around A1:Z5000, In Column N I have Cities Name.
Now I want to Create Multiple Workbooks According to the Cities Name i.e. Column N
For Example if N1:N250 has New Delhi, I want to Copy the Entire Data i.e. A1:Z250 Paste into New Workbook.
Secondly, I want to Save These Workbook As CSV. Format i.e. CSV (COMMA DELIMITED) FORMAT.
Means, New Delhi.CSV

Thanks in Advance

Hardeep Kanwar

[GTO]

Greetings Hardeep,

Written in 2000, but should work...

Option Explicit

Sub SplitCities()
Dim _
wbNew As Workbook, _
rngCities As Range, _
COL As New Collection, _
aryCities As Variant, _
i As Long

Application.ScreenUpdating = False
With Sheet1 '<---Change to CodeName or Worksheets("SheetName")
Set rngCities = .Range("A1:Z" & .Cells(Rows.Count, "N").End(xlUp).Row)
aryCities = .Range("N2:N" & .Cells(Rows.Count, "N").End(xlUp).Row).Value

On Error Resume Next
For i = LBound(aryCities) To UBound(aryCities)
COL.Add aryCities(i, 1), CStr(aryCities(i, 1))
Next
On Error GoTo 0

ReDim aryCities(1 To COL.Count)

For i = 1 To COL.Count
Set wbNew = Workbooks.Add(xlWBATWorksheet)
rngCities.AutoFilter Field:=14, Criteria1:=COL(i)
With wbNew
rngCities.SpecialCells(xlCellTypeVisible).Copy wbNew.Worksheets(1).Range("A1")
rngCities.AutoFilter Field:=14
'// Change Path to suit //
.SaveAs ThisWorkbook.Path & "\" & COL(i) & ".csv", xlCSV, , , , False
.Close False
End With
Next

rngCities.Parent.AutoFilterMode = False
Application.ScreenUpdating = True
End With
End Sub


Hope that helps,

Mark

[hardeep]

[QUOTE=GTO]Greetings Hardeep,

Written in 2000, but should work...

Option Explicit

Sub SplitCities()
Dim _
wbNew As Workbook, _
rngCities As Range, _
COL As New Collection, _
aryCities As Variant, _
i As Long

Application.ScreenUpdating = False
With Sheet1 '<---Change to CodeName or Worksheets("SheetName")
Set rngCities = .Range("A1:Z" & .Cells(Rows.Count, "N").End(xlUp).Row)
aryCities = .Range("N2:N" & .Cells(Rows.Count, "N").End(xlUp).Row).Value

On Error Resume Next
For i = LBound(aryCities) To UBound(aryCities)
COL.Add aryCities(i, 1), CStr(aryCities(i, 1))
Next
On Error GoTo 0

ReDim aryCities(1 To COL.Count)

For i = 1 To COL.Count
Set wbNew = Workbooks.Add(xlWBATWorksheet)
rngCities.AutoFilter Field:=14, Criteria1:=COL(i)
With wbNew
rngCities.SpecialCells(xlCellTypeVisible).Copy wbNew.Worksheets(1).Range("A1")
rngCities.AutoFilter Field:=14
'// Change Path to suit //
.SaveAs ThisWorkbook.Path & "\" & COL(i) & ".csv", xlCSV, , , , False
.Close False
End With
Next

rngCities.Parent.AutoFilterMode = False
Application.ScreenUpdating = True
End With
End Sub


Hope that helps,




Thanks GTO

Thanks for the Code

But, Unfortunately Its not Working

It Show the Error Message "Compile Error" Variable not Defined"

With Sheet1

When i Insert New Sheet i.e. Sheet1 and RUN the Macro

It Show the "RUN TIME ERROR "1004" DEBUG

rngCities.AutoFilter Field:=10, Criteria1:=COL(i)

I am really Sorry for My Lack of knowledge in CODES AND MACROS


Regards

Hardeep Kanwar

[hardeep]

Attached is the Example of my Question

In this Attached i have Shorten my Range i.e. columns and Rows

I want to Create Sheets According to Column E in this Attached

Regards

Hardeep Kanwar

[GTO]

Greetings Hardeep,

Written in 2000, but should work...

...
With Sheet1 '<---Change to CodeName or Worksheets("SheetName")
...etc



Thanks GTO

Thanks for the Code

But, Unfortunately Its not Working

It Show the Error Message "Compile Error" Variable not Defined"

With Sheet1

When i Insert New Sheet i.e. Sheet1 and RUN the Macro

It Show the "RUN TIME ERROR "1004" DEBUG

rngCities.AutoFilter Field:=10, Criteria1:=COL(i)

...

Hi Hardeep,

In the above, 'Sheet1' is the codename to the sheet, not the name you see on the tab. (see comments in below code) Whe you are in VBIDE, look in the Project window.

See how beside the icon for the sheet it lists, 'Sheet1(MATDATA)' ?

The first part is the sheet's codename. To change a sheet's codename, look in the properties window. With the sheet selected in the project window, you will see (Name) as the first listed property.

Anyways, in looking at the attached wb, try:

In a Standard Module:

Option Explicit

Sub SplitCities()
Dim _
wbNew As Workbook, _
rngCities As Range, _
COL As New Collection, _
aryCities As Variant, _
i As Long

Application.ScreenUpdating = False
'// Note: Sheet1 was referring to the sheet's Codename. In the workbook posted at //
'// #4, this would work - but we could also use the sheet's tab name like: //
With ThisWorkbook.Worksheets("MATDATA")
'// Here we will change the range from "A1:Z" (followed by the last row number //
'// containing data)... //
Set rngCities = .Range("A1:K" & .Cells(Rows.Count, "E").End(xlUp).Row)
'// ...and we'll change the column we are getting the cities' names from. //
aryCities = .Range("E2:E" & .Cells(Rows.Count, "E").End(xlUp).Row).Value

'// Now since our array 'aryCities' is a two-dimensional array, containing //
'// 1 to rows.count in the first dimension, and 1 to 1 in the second dimension //
'// (as there was only one column that we ripped the vals from), we can loop //
'// through the elements in the first dimension. As we do this, we'll attempt //
'// to Add each value to the Collection Object. But, as we are using each //
'// value from the array as the Key added, and, Keys must be unique, after a city's//
'// name has been added once, further attempts will fail. As we have On Error //
'// Resuming at the next statement, we end up with a collection that has each //
'// city'd name in it just once. //
On Error Resume Next
For i = LBound(aryCities) To UBound(aryCities)
COL.Add aryCities(i, 1), CStr(aryCities(i, 1))
Next
On Error GoTo 0

'// You can delete this line, I evidently suffered oxygen depravation... //
'ReDim aryCities(1 To COL.Count)

'// Now we will loop from 1 to how many unique city names we have in our collection//
For i = 1 To COL.Count
'// For each city, we will: //
'// Set a reference to a new/created one-sheet workbook, //
Set wbNew = Workbooks.Add(xlWBATWorksheet)
'// then filter by the item in the collection we are currently at in our //
'// looping... //
'// (Please note that the Field is now for Col E ) //
rngCities.AutoFilter Field:=5, Criteria1:=COL(i)

With wbNew
'// Then we will copy the visible cells from our filtered list, to our //
'// destination/new wb. //
rngCities.SpecialCells(xlCellTypeVisible).Copy wbNew.Worksheets(1).Range("A1")
'// Then 'un-filter' the sheet for next go around... //
rngCities.AutoFilter Field:=5
'// Change Path to suit //
'// Then SaveAs the new wb, as a csv, and close it. //
.SaveAs ThisWorkbook.Path & "\" & COL(i) & ".csv", xlCSV, , , , False
.Close False
End With
Next

'// remove all filtering from our range in the source. //
rngCities.Parent.AutoFilterMode = False
Application.ScreenUpdating = True
End With
End Sub


This will create the new csv files in the same folder as the workbook holding the code. Please note that I did not include any error checking to see if the files already exist.

Does that help?

Mark

[GTO]

BTW, I forgot to mention...

When posting workbooks, you can get more help by posting in pre-2007 format (ie - .xls), as there's still lots of folks (including yours truly here) who don't have 2007.

Mark

[hardeep]

BTW, I forgot to mention...

When posting workbooks, you can get more help by posting in pre-2007 format (ie - .xls), as there's still lots of folks (including yours truly here) who don't have 2007.

Mark


Thank Q very Much

You are a Life Saver for Me

And i will take Care in future while Attach the Example


Thanks Again

[GTO]

:friends: Glad that worked and most happy to help:thumb

If solved, there is an option under the Thread Tools button to mark as such.

Have a great day Hardeep,

Mark

[hardeep]

:friends: Glad that worked and most happy to help:thumb

If solved, there is an option under the Thread Tools button to mark as such.

Have a great day Hardeep,

Mark



Oops!!!!!!!!!!!

I Miss this


:clap: :clap: :clap: