Splitting data into seperate worksheets with data change

[Louise]

This is a long shot... But can anyone help me with a macro?

I have a set of data like the example below:

Name City Number

J Bloggs London 5
I Grass London 6
F Perry Manchester 2
L Owen Bournemouth 3
V Steele Liverpool 1

I need a macro to take the data and split it according to the City Name and
put each section in a new workbook. So I need a workbook for London,
Manchester, Bournemouth & Liverpool in this instance with the relevant data
pasted into it from the main sheet.

Is this possible and how would I go about creating this please?

I thank anyone for their help!!!

 

[Don Guillett]

Can you just use data>filter>autofilter and filter on the city.

 

[Ron de Bruin]

Hi Louise

See this page
http://www.rondebruin.nl/copy5.htm

Try the workbook example

 

[Louise]

Thanks for the response Don but I what I failed to mention in my post is that
I have to create 6-10 workbooks from one file of 65000 rows, and I need to do
this with 8 original files, so to do it manually will take FOREVER - so I'd
rather automate it...

 

[Louise]

This looks perfect - Thank you!

Hi Louise

See this page
http://www.rondebruin.nl/copy5.htm

Try the workbook example

 

[john]

Lousie,
this may do what you want:

Sub FilterDataToWorkBook()
Dim ws1 As Worksheet
Dim wsNew As Workbook
Dim rng As Range
Dim lr As Integer
Dim c As Range

'worksheet where your data is stored
'change sheet name as required
Set ws1 = ThisWorkbook.Worksheets("Sheet1")

With ws1

lr = .Cells(.Rows.Count, "A").End(xlUp).Row


Set rng = .Range("A1:C" & lr)

'extract list
.Columns("B:B").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), Unique:=True

lr = .Cells(.Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
.Range("L1").Value = .Range("B1").Value

For Each c In .Range("J2:J" & lr)
'add the name to the criteria area
.Range("L2").Value = c.Value


'add new workbook and run advanced filter
Set wsNew = Workbooks.Add
wsNew.Sheets(1).Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=wsNew.Sheets(1).Range("A1"), _
Unique:=False

Next

.Activate
.Columns("J:L").Delete

End With
End Sub

 

[Louise]

Hi

I finally got around to using this for real and it works great, only thing
is the macro is not completing and is erroring out. I go to debug and it
shows me it has broken at this point (I have included a little above it too
but it the yellow highlights My_Range.AutoFilter....):

'loop through the unique list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A4:A" & Lrow)
'Filter the range
My_Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _
Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"),
"?", "~?")

I have used the code you have labelled as Create a new workbook for all
unique values which is precisely what I need to do.

My workbook is named Test Data, my worksheet is named Sheet1. I have
columns A - Q and am using column H as my data change column. There are
approx 2000 records in my spreadsheet. I think I must have not changed
something but have no idea with such complicated code what to change.

I checked and when it needs debugging, a new folder has been created and all
workbooks that I am expecting to have been created are present and full of
correct info. My Test Data workbook has only Column A remaining with the
data change criteria headings and shortcut links to the new workbooks.

Can someone tell me why this is erroring and how I can get the macro to
complete in an orderly fashion?

Many Thanks!!!

 

[Ron de Bruin]

Hi Louise

I like to see your test workbook

Send it to me private and I take a look



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm