ExcelBanter - Filtering results

Try this one

Copy the macro and functions in a normal module in the Customer workbook

Change the sheet name and range to yours

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:A100")

Sub Copy_With_AdvancedFilter()
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim Lr As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:A100")
'Use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic
'This example filter on the first column in the range (change this if needed)

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use this columns)
Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

If SheetExists(cell.Value) = False Then
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
Else
Set WSNew = Sheets(cell.Value)
End If

Lr = LastRow(Sheets(cell.Value))

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A" & Lr + 1), _
Unique:=False
Next
.Columns("IU:IV").Clear
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl

"GazMo" wrote in message ...

I have Spreadhseet that contains 2 main workbooks (like databases) - one
for Suppliers and one for Customers ... I have written a macro in the
suppliers workbook that creates new worksheets for each different code
no and names the tab accordingly. (based on
http://www.contextures.com/excelfile...epFiltered.xls)

Now I want to add a macro in the Customer workbook that will do the
same but put the relevant Customer data (including titles) in the
relevant tab (if already created) UNDER any existing data, and also
create a new tab if one hasnt been created already from the Supplier
workbook.

Any ideas ???

Cheers all

--
GazMo
------------------------------------------------------------------------
GazMo's Profile: http://www.excelforum.com/member.php...o&userid=14610
View this thread: http://www.excelforum.com/showthread...hreadid=269267