Splitting Spreadsheet by Town

This is a relatively simple task that can be accomplished easily in MS Access if you are willing to go down that road. Simply, you would import your table into Access. Build a combo box for a lookup on the unique town names and write a query to have only each town queried and have the results exported to Excel.

Use this code in a blank module of your file. Press Alt+F11 you will see a code window open. On the left hand side you will see microsoft excel objects. Right click and insert module. Copy this code over and save the file. Go to the excel sheet and select Tools->Macro->Macros and run it.

Please Login or Register  to view this content.

Just a question - if u r using excel 2003, how are you managing with 100000+ rows? The limit is 65536.

Here's some code to split to separate workbooks, you can adjust it to suit

Please Login or Register  to view this content.

Option Explicit

'---------------------------------------------------------------------------------------
' DateTime : 24/09/2006 22:48
' Author : Roy Cox (royUK)
' Website : more examples
' Purpose : Create a sheet for each unique name in data
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.
'---------------------------------------------------------------------------------------

Sub ExtractToSheets()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim rData As Range
Dim rCl As Range
Dim sNm As String
Set ws = Sheet1

'extract a list of unique names
'first clear existing list
With ws
.range containing data, table will be picked up automatically
'change cells(1,1) if table does not start in A1
Set rData = .Range(.Cells(1, 1).CurrentRegion
.Columns(.Columns.Count).Clear
.Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

For Each rCl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
sNm = rCl.Text
'add new sheet (only if required-NB uses UDF)
If WksExists(sNm) Then
'so clear contents
Sheets(sNm).Cells.Clear
Else
'new sheet required
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count) 'move to end
wsNew.Name = sNm
End If
.currently categories in Column C, change AutoFilter Field for different Column
'AutoFilter & copy to relevant sheet
rData.AutoFilter Field:=3, Criteria1:=sNm
rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
Next rCl
End With
ws.Columns(Columns.Count).ClearContents 'remove temporary list
rData.AutoFilter 'switch off AutoFilter
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
[/code]

Hello dannymcg,

Welcome to the Forum!

The following macro has been added to the attached workbook. This will create and save a new workbook for each town in column "F" along with all records for that town.

Please Login or Register  to view this content.

Hey Danny,

If u r using 2007, it will good if u change your profile entry to reflect that.

What runtime error are u getting?