Hi all,
I seem to be having trouble implementing some code from Debra
Dalgleish... I posted my original question in the 'functions' section
as I was looking for a formula however I think this area may be more
suitable for my question now that i'm trying to use Debra's sample...
The original thread is at
http://www.excelforum.com/showthread.php?t=390438
The Advanced Filter sample seems to do exactly what i want it to do but
when I change the code to suit 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
--------------------
--
jarviscars
------------------------------------------------------------------------
jarviscars's Profile:
http://www.excelforum.com/member.php...o&userid=25631
View this thread:
http://www.excelforum.com/showthread...hreadid=390833