I thought you wanted to collect all the data from the same row. (ie.
put out all the rows that contain "Location A" to sheet LocationA)
Maybe I misunderstood what you wanted to do.

Anyway, I am not VBA expert and would not even consider myself as a
beginner. :) Sorry cannot help you on VBA.


jarviscars Wrote:
Thanks Morrigan... but that seems to be returning any value of the same
row in the master sheet.

I found a sample workbook by Debra Dalgleish which used macros and
filters to create sheets dynamically based on the value of a certain
column. This appears to do what I want it to do but i'm no VB expert
and when trying to convert it across to my workbook, i get a runtime
error...

Run-time error '1004':
Method 'Range' of object '_Global' failed

When I click <<Debug the vb editor seta a break point at line 10

Code:
--------------------
Set rng = Range("Database")
--------------------


Am I missing something completely obvious???
(Code below)

Thanks in advance.


Code:
--------------------
Option Explicit

Sub ExtractLocations()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Cars without Photos")
Set rng = Range("Database")

'extract a list of Locations
ws1.Columns("B:B").Copy _
Destination:=Range("L1")
ws1.Columns("L:L").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row

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

For Each c In Range("J2:J" & r)
'add the Location to the criteria area
ws1.Range("L2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Cars without Photos").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A2"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Cars without Photos").Range("L1:L2"), _
CopyToRange:=wsNew.Range("A2"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("J:L").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function
--------------------



--
Morrigan
------------------------------------------------------------------------
Morrigan's Profile: http://www.excelforum.com/member.php...fo&userid=7094
View this thread: http://www.excelforum.com/showthread...hreadid=390438