I'm hoping someone can assist me in creating a report. I have a master
sheet of sales information relating to a number of locations, a
manager looks after a certain number of each of the locations. I wish
to extract on a new File (for each Manager) the information that
relates to them, using the same formats that exists on the master
file. This would be created each month. I would have a table setup
that equates London; Paris; New York with "ManagerA"; Berlin; Boston;
Manchester; Leeds with "ManagerB" etc etc

My info starts on Row 10 on a sheet called master, and can be variable
in lenghth each month. The distinguishing feature on each row that
identifies an area is specified in column B. So if Column B on row 10
said "London" this would be extracted (the extire row, values, formats
etc) to a new file that would self name as whatever the master file
was called+ManagerA. If Column B on row 11 said "Paris" this would be
extracted (the extire row, values, formats etc) to a new file that
would self name as whatever the master file was called+ManagerA. If
Column B on row 12 said "Boston" this would be extracted (the extire
row, values, formats etc) to a new file that would self name as
whatever the master file was called+ManagerB etc etc. This would
continue until the first empty cell in Column A lower than row 10


Thanks for any pointers

The code below, extract from Debra Dalgleish's Contextures site kinda
does what I want, except for a couple of things,

(1) it extracts to a new sheet, whereas I'm looking 'ideallly' to a
new file
(2) it has listed the manager per row, weheras I associate a number of
locations to set managers and don't have this listed on each row


Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").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("C1").Value

For Each c In Range("J2:J" & r)
'add the rep name 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("Sheet1").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
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

#1. Is there one new file when you're done--with lots of worksheets? Or lots
of workbooks with just one worksheet each when you're done?

#2. I think if you're going to use this advancedfilter and autofilter
technique, you'll have to have the info on each row. You can do it yourself--or
maybe add code to add that info, do the work and remove the column.

Sean wrote:

The code below, extract from Debra Dalgleish's Contextures site kinda
does what I want, except for a couple of things,

(1) it extracts to a new sheet, whereas I'm looking 'ideallly' to a
new file
(2) it has listed the manager per row, weheras I associate a number of
locations to set managers and don't have this listed on each row

Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").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("C1").Value

For Each c In Range("J2:J" & r)
'add the rep name 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("Sheet1").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
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

--

Dave Peterson

Hi Dave

# 1 Lots of workbooks with 1 sheet (actually only 4 workbooks in
total)

# 2 On entering the 'Manager name' per row, I guess one could insert a
new column (or use the first free column on the extreme right of my
data) via code. How would I right something like Insert ManagerA in
Column Z if value is ColumnB is any one of "London"; "Paris"; "New
York", insert ManagerB if one of "Berlin"; "Boston"; "Manchester";
"Leeds" etc etc, keeping checking/inserting in ColZ until the first
blank cell in ColB row.... Then use Debra's code taking a/c # 1 above

I don't think I've explained it too well, but hope you get the
flavour. Basically I've a whole load of data, that I want to share,
except only those rows that relate to each regional manager

Thanks

I've used an example from Ron De Bruin's site, which gives me a lot,
see below

http://www.rondebruin.nl/copy5.htm#AutoFilter

I've tried to add 9 crieria to extract the locations I want with a
line

rng.AutoFilter Field:=1, Criteria1:="=Loc1", Operator:=xlOr,
Criteria2:="=Loc2", Operator:=xlOr, Criteria3:="=Loc3",
Operator:=xlOr, Criteria4:="=Loc4", Operator:=xlOr,
Criteria5:="=Loc5", Operator:=xlOr, Criteria6:="=Loc6",
Operator:=xlOr, Criteria7:="=Loc7", Operator:=xlOr,
Criteria8:="=Loc8", Operator:=xlOr, Criteria9:="=Loc9"

But it hits debug with error "Named arguement not found" at Criteria3
- have I inserted too many criteria?

Hi Sean

One easy way might be to use a formula in your source worksheet in column Z
=IF(ISNUMBER(SEARCH(B1,managerA)),"MangerA",IF(ISN UMBER(SEARCH(B1,ManagerB)),"ManagerB",""))

where you have set up names for ManagerA, ManagerB etc. using
InsertNameDefineName ManagerA Refers to "London", "Paris", "New York"

Then having created the Manager in column Z, use that as your criteria in
the Advanced Filter using Debra's code.

When it is Finished, you will have sheets (in the same Workbook) with the
various splits.
As it is only 4 files you want, then it is easy enough to Right click on the
relevant tabMove or Copyclick Copychoose New Workbook as DestinationSave
new Workbook as required.
--

Regards
Roger Govier

"Sean" wrote in message
...
Hi Dave

# 1 Lots of workbooks with 1 sheet (actually only 4 workbooks in
total)

# 2 On entering the 'Manager name' per row, I guess one could insert a
new column (or use the first free column on the extreme right of my
data) via code. How would I right something like Insert ManagerA in
Column Z if value is ColumnB is any one of "London"; "Paris"; "New
York", insert ManagerB if one of "Berlin"; "Boston"; "Manchester";
"Leeds" etc etc, keeping checking/inserting in ColZ until the first
blank cell in ColB row.... Then use Debra's code taking a/c # 1 above

I don't think I've explained it too well, but hope you get the
flavour. Basically I've a whole load of data, that I want to share,
except only those rows that relate to each regional manager

Thanks

Just like when you use data|filter|autofilter, you get up to 2 criteria.

Sean wrote:

I've used an example from Ron De Bruin's site, which gives me a lot,
see below

http://www.rondebruin.nl/copy5.htm#AutoFilter

I've tried to add 9 crieria to extract the locations I want with a
line

rng.AutoFilter Field:=1, Criteria1:="=Loc1", Operator:=xlOr,
Criteria2:="=Loc2", Operator:=xlOr, Criteria3:="=Loc3",
Operator:=xlOr, Criteria4:="=Loc4", Operator:=xlOr,
Criteria5:="=Loc5", Operator:=xlOr, Criteria6:="=Loc6",
Operator:=xlOr, Criteria7:="=Loc7", Operator:=xlOr,
Criteria8:="=Loc8", Operator:=xlOr, Criteria9:="=Loc9"

But it hits debug with error "Named arguement not found" at Criteria3
- have I inserted too many criteria?

--

Dave Peterson

#1.

=if(or(b2={"London","Paris","New York"}),"managerA","unknown")

I think I'd create a new sheet (hide it later) with the towns in column A and
the manager's name in column B.

Then I could use:
=if(isna(vlookup(b2,sheet2!a:b,2,false)),"Unknown" ,vlookup(b2,sheet2!a:b,2,0))

I think it would make updating a bit easier when the managers change.

#2.

Try replacing this portion:

If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If

with
'workbooks.add(1) creates a new workbook with a single sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = workbooks.add(1).worksheets(1)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If

Sean wrote:

Hi Dave

# 1 Lots of workbooks with 1 sheet (actually only 4 workbooks in
total)

# 2 On entering the 'Manager name' per row, I guess one could insert a
new column (or use the first free column on the extreme right of my
data) via code. How would I right something like Insert ManagerA in
Column Z if value is ColumnB is any one of "London"; "Paris"; "New
York", insert ManagerB if one of "Berlin"; "Boston"; "Manchester";
"Leeds" etc etc, keeping checking/inserting in ColZ until the first
blank cell in ColB row.... Then use Debra's code taking a/c # 1 above

I don't think I've explained it too well, but hope you get the
flavour. Basically I've a whole load of data, that I want to share,
except only those rows that relate to each regional manager

Thanks

--

Dave Peterson

Dave, I've got a little routine (see very bottom of post) which places
the Managers name in ColR, but I'm a little lost as to what I proceed
next with i.e. the filtering and how I can get this to appear on a new
file for each.

My data goes from A12:R.. I also have some text above Row12 which I
would like to have on each Managers file too

I've tried below, but I get a "End if without Block if" not sure why
on the last End if.

I've ignored your comment on #2 for the moment just want to get the
basic's of the filter working

Option Explicit


Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("2007")
Set rng = Range("Database")


'extract a list of Sales Reps
ws1.Columns("R:R").Copy _
Destination:=Range("X12")
ws1.Columns("X:X").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("Y12"), Unique:=True
r = Cells(Rows.Count, "Y").End(xlUp).Row


'set up Criteria Area
Range("X1").Value = Range("R1").Value


For Each c In Range("Y12:Y" & r)

'workbooks.add(1) creates a new workbook with a single sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("2007").Range("X12:X13"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("X:Y").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function




Routine is:

Sub InsertAMName()

Application.ScreenUpdating = False

With Application
.Calculation = xlManual
.MaxChange = 0.001
End With

Sheets("2007").Select

Range("R13").Select
ActiveCell.Formula = "=VLOOKUP(B13,AM_Lookup,2)"

Range("R13").Copy
x = 13
Do Until Cells(x, 1).Value = ""
Cells(x, 18).PasteSpecial xlPasteFormulas
x = x + 1
Loop

With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With

Range("A1").Select

ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True

End Sub

How about:

Option Explicit
Sub ExtractReps()

Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Long
Dim c As Range
Dim LastRow As Long

Set ws1 = Sheets("2007")

With ws1
.Range("R:IV").Delete

'rebuild it each time???
Call InsertAMName

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:r" & LastRow)

'extract a list of unique managers in column Y
.Range("r12:r" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), _
Unique:=True

r = Cells(.Rows.Count, "Y").End(xlUp).Row

For Each c In Range("Y2:Y" & r).Cells
'workbooks.add(1) creates a new workbook with a single sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value

'build the criteria range in X1:X2
.Range("x1").Value = .Range("y1").Value
.Range("x2").Value = "=" & Chr(34) & "=" & c.Value & Chr(34)

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

wsNew.Range("R:iv").Delete
Next c
End With
ws1.Parent.Activate
ws1.Select
ws1.Columns("R:IV").Delete
End Sub

Sub InsertAMName()

Dim LastRow As Long

Application.ScreenUpdating = False

With Worksheets("2007")
'add a header for column R in Row 12
.Range("R12").Value = "Manager"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"
End With

Application.ScreenUpdating = True

End Sub



Sean wrote:

Dave, I've got a little routine (see very bottom of post) which places
the Managers name in ColR, but I'm a little lost as to what I proceed
next with i.e. the filtering and how I can get this to appear on a new
file for each.

My data goes from A12:R.. I also have some text above Row12 which I
would like to have on each Managers file too

I've tried below, but I get a "End if without Block if" not sure why
on the last End if.

I've ignored your comment on #2 for the moment just want to get the
basic's of the filter working

Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("2007")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("R:R").Copy _
Destination:=Range("X12")
ws1.Columns("X:X").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("Y12"), Unique:=True
r = Cells(Rows.Count, "Y").End(xlUp).Row

'set up Criteria Area
Range("X1").Value = Range("R1").Value

For Each c In Range("Y12:Y" & r)

'workbooks.add(1) creates a new workbook with a single sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("2007").Range("X12:X13"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("X:Y").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

Routine is:

Sub InsertAMName()

Application.ScreenUpdating = False

With Application
.Calculation = xlManual
.MaxChange = 0.001
End With

Sheets("2007").Select

Range("R13").Select
ActiveCell.Formula = "=VLOOKUP(B13,AM_Lookup,2)"

Range("R13").Copy
x = 13
Do Until Cells(x, 1).Value = ""
Cells(x, 18).PasteSpecial xlPasteFormulas
x = x + 1
Loop

With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With

Range("A1").Select

ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True

End Sub

--

Dave Peterson

David the Filter criteria range (In X, Y) is showing some odd things,
and I think its the cos of a debug error.

It looks like

Manager Manager
=ManagerE ManagerA
ManagerB
ManagerC
ManagerD
ManagerE
#N/A

The #N/a appears in Y7 as above

It hits a Type mismatch debug on line "wsNew.Name = c.Value"

Q - How can I get the entire format of the Sheet 2007 to be replicated
on all the filtered sheets? (Column widths)

The easy one...

If you're using xl2k or higher, you can record a macro when you select the
columns (A:R) of 2007 and then do a Paste Special|Column Widths.

And if you're getting an error in column Y, then look at your formula in column
R. You have at least on row that doesn't have a match on in your first column
of the AM_Lookup range. So fix your table for the manager that's causing the
error.

ps.

The funny =ManagerE is a way to make sure that you get what you want on that new
worksheet.

If you used:
Manager
ManagerA
ManagerAB
ManagerABC

Then a criteria range of:
Manager (in Y1)
Manager (in Y2)
would return all those managers.

Manager (in Y1)
=Manager (in Y2)
will give just that unique manager.





Sean wrote:

David the Filter criteria range (In X, Y) is showing some odd things,
and I think its the cos of a debug error.

It looks like

Manager Manager
=ManagerE ManagerA
ManagerB
ManagerC
ManagerD
ManagerE
#N/A

The #N/a appears in Y7 as above

It hits a Type mismatch debug on line "wsNew.Name = c.Value"

Q - How can I get the entire format of the Sheet 2007 to be replicated
on all the filtered sheets? (Column widths)

--

Dave Peterson

Ah, I see. Below the very last detail row I have #n/a (on row 2861).
However the piece of code that enters the lookup formula is

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"

However in the above what does the "Last Row" actually mean?. The last
detail row is 2860, row 2861 is a blank row and row 2862 has a line
top and bottom. I'm assuming the code above interprets 2862 as the
last, but how can I tweak it that it knows 2860 is? My previous code
did that, but I guess it was inefficent in how it operated, thus you
suggested the above.

I am doing this Report each month and the format is always the same,
although the number of detail lines varies. By this I mean there will
always be a blank line followed by a line with top and bottom line
formatted (there are some totals on some columns for this line)

Thanks

Last row was based on the data in column A.

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

If lastrow = 2861, then you have data in A2861 (a misplaced space
character???). Formatting won't affect this. You really have something in
A2861.

You can either clear the cell (I would!) or adjust the line:

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 1




Sean wrote:

Ah, I see. Below the very last detail row I have #n/a (on row 2861).
However the piece of code that enters the lookup formula is

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"

However in the above what does the "Last Row" actually mean?. The last
detail row is 2860, row 2861 is a blank row and row 2862 has a line
top and bottom. I'm assuming the code above interprets 2862 as the
last, but how can I tweak it that it knows 2860 is? My previous code
did that, but I guess it was inefficent in how it operated, thus you
suggested the above.

I am doing this Report each month and the format is always the same,
although the number of detail lines varies. By this I mean there will
always be a blank line followed by a line with top and bottom line
formatted (there are some totals on some columns for this line)

Thanks

--

Dave Peterson

ps. remember that there are two occurences of that line--one in each
subroutine.

Sean wrote:

Ah, I see. Below the very last detail row I have #n/a (on row 2861).
However the piece of code that enters the lookup formula is

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"

However in the above what does the "Last Row" actually mean?. The last
detail row is 2860, row 2861 is a blank row and row 2862 has a line
top and bottom. I'm assuming the code above interprets 2862 as the
last, but how can I tweak it that it knows 2860 is? My previous code
did that, but I guess it was inefficent in how it operated, thus you
suggested the above.

I am doing this Report each month and the format is always the same,
although the number of detail lines varies. By this I mean there will
always be a blank line followed by a line with top and bottom line
formatted (there are some totals on some columns for this line)

Thanks

--

Dave Peterson

Thanks Dave

I did a COUNT and LEN in A2861 but it returned 0, so not sure, I
modified as per your suggestion -

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 1

But that still left a #n/a in R2861, so I changed it to -

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2 and it seems to
have worked

There was data in Row 2862 but none in Row 2861, in that instance
would you have expected LastRow = .Cells(.Rows.Count,
"A").End(xlUp).Row to work?

Anyway above is working.

On the formatting, recording the macro etc is fine, but how do I
select the relevant Sheets/File name when I can't reference a specific
File name as it could be 'anything' once the code creates the new
workbook. Below hard codes a copy formats to Sheet7, but next time I
run the code a new Sheet4 might be created?

Columns("A:R").Select
Selection.Copy
Windows("Sheet7").Activate
Columns("A:R").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

wsNew.Range("R:iv").Delete

could become

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

.Columns("A:R").copy
wsnew.range("A1").pastespecial paste:=xlPasteColumnWidths

wsNew.Range("R:iv").Delete

(Untested and uncompiled.)

========
That last line deletes column R from the new worksheet in the new workbook. You
may want to change that.

And I didn't understand the layout of your data. If you have that extra row 2
rows down, then subtracting 2 is what you want to do.

ps. if you're using xl2k, then change xlpastecolumnwidths to 8. It's a bug
that was fixed in xl2002.

Sean wrote:

Thanks Dave

I did a COUNT and LEN in A2861 but it returned 0, so not sure, I
modified as per your suggestion -

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 1

But that still left a #n/a in R2861, so I changed it to -

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2 and it seems to
have worked

There was data in Row 2862 but none in Row 2861, in that instance
would you have expected LastRow = .Cells(.Rows.Count,
"A").End(xlUp).Row to work?

Anyway above is working.

On the formatting, recording the macro etc is fine, but how do I
select the relevant Sheets/File name when I can't reference a specific
File name as it could be 'anything' once the code creates the new
workbook. Below hard codes a copy formats to Sheet7, but next time I
run the code a new Sheet4 might be created?

Columns("A:R").Select
Selection.Copy
Windows("Sheet7").Activate
Columns("A:R").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select

--

Dave Peterson

I'm on xl2003 Dave.Code works great. Deleting ColR is fine, don't need
that on the Exported Files

I've tried to plagiarise your code to set the Zoom and Gridlines,
like-

wsNew.Range("A1").ActiveWindow.Zoom = 75
wsNew.Range("A1").ActiveWindow.DisplayGridlines = False

But guess I'm not that clever. I've tweaked by deleting the
"activewindow" text, but didn't work and I'm only guessing

My layout, essentially has the Data listed from Row 13 (header info on
Row 12), then below the last detailed line (row 2860 in this
instance), I have a blank row (row2861), then just below that is a
Total line (row 2862)

zoom and displaygridlines work on windows.

wsnew.select
activewindow.zoom = 75
activewindow.displaygridlines = false

There's not many things you have to select to work on, but I think these two are
a pair of them.

Sean wrote:

I'm on xl2003 Dave.Code works great. Deleting ColR is fine, don't need
that on the Exported Files

I've tried to plagiarise your code to set the Zoom and Gridlines,
like-

wsNew.Range("A1").ActiveWindow.Zoom = 75
wsNew.Range("A1").ActiveWindow.DisplayGridlines = False

But guess I'm not that clever. I've tweaked by deleting the
"activewindow" text, but didn't work and I'm only guessing

My layout, essentially has the Data listed from Row 13 (header info on
Row 12), then below the last detailed line (row 2860 in this
instance), I have a blank row (row2861), then just below that is a
Total line (row 2862)

--

Dave Peterson

Dave, many thanks for your interest in helping me out, which you have
done many times on this NG. Your code works a treat and will save me a
lot of time. I have ideas in terms of 'glossing up' what it now
achieves but this particular thread is accomplished

Thanks again

Sean

Glad you got it working.

I would have guessed that wsnew would have been the activesheet/activewindow.

So the first line in this section wasn't needed:

wsnew.select
activewindow.zoom = 75
activewindow.displaygridlines = false

If it were really needed, then this code has a bug. The workbook that owns
wsnew has to be active to be able to select that worksheet. You should add one
more line:

wsnew.parent.activate
wsnew.select
activewindow.zoom = 75
activewindow.displaygridlines = false

Sean wrote:

Dave, many thanks for your interest in helping me out, which you have
done many times on this NG. Your code works a treat and will save me a
lot of time. I have ideas in terms of 'glossing up' what it now
achieves but this particular thread is accomplished

Thanks again

Sean

--

Dave Peterson

Dave, it seems to work with and without wsnew.parent.activate, so I've
placed it in the code anyway

As I'm on it I might as well ask. How could I create a Subtotal on
each of the new sheets? The recorded version is below, however the
ranges I have are variable for each sheet, depending on the lines of
data, although everything starts at A12:Q, so I can't hard code these
in, I could I guess use a Dynamic Range, but how could I create one of
these via code?



Range("A12:Q49").Select
Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("A1").Select
End Sub

'....
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

wsNew.Range("R:iv").Delete

with wsnew
'no adjustment here!
lastrow = .cells(.rows.count,"A").end(xlup).row
.range("a12:q" & lastrow).subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

'maybe you want this, too
.parent.saveas _
filename:=c.parent.parent.path & "\" & c.value & ".xls", _
fileformat:=xlworkbook.normal
.parent.close savechanges:=false
end with
Next c

I've lost track of what the details of the code really are.

If c.value is a valid name to Windows, you could add that last step to save in
the same folder as the original workbook.

c.parent is the worksheet (2007, I think)
c.parent.parent is the workbook that owns that worksheet.

you could also be specific:

.parent.saveas _
filename:="C:\myexistingpathnamehere\" & c.value & ".xls", _
fileformat:=xlworkbook.normal

Sean wrote:

Dave, it seems to work with and without wsnew.parent.activate, so I've
placed it in the code anyway

As I'm on it I might as well ask. How could I create a Subtotal on
each of the new sheets? The recorded version is below, however the
ranges I have are variable for each sheet, depending on the lines of
data, although everything starts at A12:Q, so I can't hard code these
in, I could I guess use a Dynamic Range, but how could I create one of
these via code?

Range("A12:Q49").Select
Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("A1").Select
End Sub

--

Dave Peterson

Dave, that Subtotal code is superb and now you have me thinking on the
save routine. What if I was to save each Exported file in the format
"Original File Name - Worksheet Name" i.e. the sheet name that is
given to each Exported file, all saved to a specific file path and if
file exists it replaces whatever is there. Reason for this is that
I'll just replace each file with a new one each month

I'm guessing is something like, but not sure how to obtain the parent
name and add the dash

.parent.saveas _
filename:="C:\myexistingpathnamehere\.parentname " & -
c.value & ".xls", _
fileformat:=xlworkbook.normal
.parent.close savechanges:=false

My working code is below:

Option Explicit
Sub ExtractAMs()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Long
Dim c As Range
Dim LastRow As Long

Application.ScreenUpdating = False

Set ws1 = Sheets("2007")

With ws1
.Range("R:IV").Delete

'rebuild it each time???
Call InsertAMName

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:r" & LastRow)

'extract a list of unique managers in column Y
.Range("r12:r" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), _
Unique:=True

r = Cells(.Rows.Count, "Y").End(xlUp).Row

For Each c In Range("Y2:Y" & r).Cells
'workbooks.add(1) creates a new workbook with a single
sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value

'build the criteria range in X1:X2
.Range("x1").Value = .Range("y1").Value
.Range("x2").Value = "=" & Chr(34) & "=" & c.Value &
Chr(34)

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

.Columns("A:Q").Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

wsNew.Parent.Activate
wsNew.Select
ActiveWindow.Zoom = 75
ActiveWindow.DisplayGridlines = False

wsNew.Select
Range("A1").Select

With wsNew
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With


wsNew.Range("R:iv").Delete
Next c
End With
ws1.Parent.Activate
ws1.Select
ws1.Columns("R:IV").Delete
End Sub
Sub InsertAMName()
Dim LastRow As Long
Application.ScreenUpdating = False
With Worksheets("2007")
'add a header for column R in Row 12
.Range("R12").Value = "Manager"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"
End With
End Sub

Dim myFileName as string 'at the top near the other dim's

.....

myfilename = c.parent.parent.fullname 'includes path, too
'remove the .xls
myfilename = left(myfilename, len(myfilename) - 4)
add the worksheet name and .xls
myfilename = myfilename & " - " & c.value & ".xls"

'stop the "overwrite?" prompt
application.displayalerts = false
..parent.saveas filename:=myfilename, fileformat:=xlworkbooknormal
application.displayalerts = true

'close it
..parent.close savechanges:=false

===
Ps. I hate to see unqualified ranges!

wsNew.Select
Range("A1").Select
becomes
wsNew.Select
wsnew.Range("A1").Select



Sean wrote:

Dave, that Subtotal code is superb and now you have me thinking on the
save routine. What if I was to save each Exported file in the format
"Original File Name - Worksheet Name" i.e. the sheet name that is
given to each Exported file, all saved to a specific file path and if
file exists it replaces whatever is there. Reason for this is that
I'll just replace each file with a new one each month

I'm guessing is something like, but not sure how to obtain the parent
name and add the dash

.parent.saveas _
filename:="C:\myexistingpathnamehere\.parentname " & -
c.value & ".xls", _
fileformat:=xlworkbook.normal
.parent.close savechanges:=false

My working code is below:

Option Explicit
Sub ExtractAMs()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Long
Dim c As Range
Dim LastRow As Long

Application.ScreenUpdating = False

Set ws1 = Sheets("2007")

With ws1
.Range("R:IV").Delete

'rebuild it each time???
Call InsertAMName

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:r" & LastRow)

'extract a list of unique managers in column Y
.Range("r12:r" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), _
Unique:=True

r = Cells(.Rows.Count, "Y").End(xlUp).Row

For Each c In Range("Y2:Y" & r).Cells
'workbooks.add(1) creates a new workbook with a single
sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value

'build the criteria range in X1:X2
.Range("x1").Value = .Range("y1").Value
.Range("x2").Value = "=" & Chr(34) & "=" & c.Value &
Chr(34)

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

.Columns("A:Q").Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

wsNew.Parent.Activate
wsNew.Select
ActiveWindow.Zoom = 75
ActiveWindow.DisplayGridlines = False

wsNew.Select
Range("A1").Select

With wsNew
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

wsNew.Range("R:iv").Delete
Next c
End With
ws1.Parent.Activate
ws1.Select
ws1.Columns("R:IV").Delete
End Sub
Sub InsertAMName()
Dim LastRow As Long
Application.ScreenUpdating = False
With Worksheets("2007")
'add a header for column R in Row 12
.Range("R12").Value = "Manager"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"
End With
End Sub

--

Dave Peterson

Dave, that code has done something strange, its created a new file,
named correctly but only for the first manager in the filter yet has
all the original files data (should only have that managers data).
Perhaps its where I placed the code which was after

With wsNew
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

I don't understand the question. Maybe you could rephrase.

And include all the current code.

Sean wrote:

Dave, that code has done something strange, its created a new file,
named correctly but only for the first manager in the filter yet has
all the original files data (should only have that managers data).
Perhaps its where I placed the code which was after

With wsNew
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

--

Dave Peterson

Dave, here it is as it now stands, I've definitely not put something
in correctly on the 'save' routine


Option Explicit
Sub ExtractAMs()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Long
Dim c As Range
Dim LastRow As Long
Dim myFileName As String

Application.ScreenUpdating = False

Set ws1 = Sheets("2007")

With ws1
.Range("R:IV").Delete

'rebuild it each time???
Call InsertAMName

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:r" & LastRow)

'extract a list of unique managers in column Y
.Range("r12:r" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), _
Unique:=True

r = Cells(.Rows.Count, "Y").End(xlUp).Row

For Each c In Range("Y2:Y" & r).Cells
'workbooks.add(1) creates a new workbook with a single
sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value

'build the criteria range in X1:X2
.Range("x1").Value = .Range("y1").Value
.Range("x2").Value = "=" & Chr(34) & "=" & c.Value &
Chr(34)

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

.Columns("A:Q").Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

wsNew.Parent.Activate
wsNew.Select
ActiveWindow.Zoom = 75
ActiveWindow.DisplayGridlines = False

wsNew.Select
Range("A1").Select

With wsNew
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With


myFileName = c.Parent.Parent.FullName 'includes path, too
'remove the .xls
myFileName = Left(myFileName, Len(myFileName) - 4)
'add the worksheet name and .xls
myFileName = myFileName & " - " & c.Value & ".xls"


'stop the "overwrite?" prompt
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myFileName,
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True


'close it
.Parent.Close savechanges:=False


wsNew.Range("R:iv").Delete
Next c
End With
ws1.Parent.Activate
ws1.Select
ws1.Columns("R:IV").Delete
End Sub
Sub InsertAMName()
Dim LastRow As Long
Application.ScreenUpdating = False
With Worksheets("2007")
'add a header for column R in Row 12
.Range("R12").Value = "Manager"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"
End With
End Sub

Without looking too closely, this line:

wsNew.Range("R:iv").Delete

is in the wrong location--either delete it or move it before the .saveas line.

But I still don't understand your problem.

Sean wrote:

Dave, here it is as it now stands, I've definitely not put something
in correctly on the 'save' routine

Option Explicit
Sub ExtractAMs()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Long
Dim c As Range
Dim LastRow As Long
Dim myFileName As String

Application.ScreenUpdating = False

Set ws1 = Sheets("2007")

With ws1
.Range("R:IV").Delete

'rebuild it each time???
Call InsertAMName

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:r" & LastRow)

'extract a list of unique managers in column Y
.Range("r12:r" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), _
Unique:=True

r = Cells(.Rows.Count, "Y").End(xlUp).Row

For Each c In Range("Y2:Y" & r).Cells
'workbooks.add(1) creates a new workbook with a single
sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value

'build the criteria range in X1:X2
.Range("x1").Value = .Range("y1").Value
.Range("x2").Value = "=" & Chr(34) & "=" & c.Value &
Chr(34)

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

.Columns("A:Q").Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

wsNew.Parent.Activate
wsNew.Select
ActiveWindow.Zoom = 75
ActiveWindow.DisplayGridlines = False

wsNew.Select
Range("A1").Select

With wsNew
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

myFileName = c.Parent.Parent.FullName 'includes path, too
'remove the .xls
myFileName = Left(myFileName, Len(myFileName) - 4)
'add the worksheet name and .xls
myFileName = myFileName & " - " & c.Value & ".xls"

'stop the "overwrite?" prompt
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myFileName,
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True

'close it
.Parent.Close savechanges:=False

wsNew.Range("R:iv").Delete
Next c
End With
ws1.Parent.Activate
ws1.Select
ws1.Columns("R:IV").Delete
End Sub
Sub InsertAMName()
Dim LastRow As Long
Application.ScreenUpdating = False
With Worksheets("2007")
'add a header for column R in Row 12
.Range("R12").Value = "Manager"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"
End With
End Sub

--

Dave Peterson

The save routine is not quite what I was looking for. I'm looking to
have the exported/filtered files saved into the same location as the
parent file, with a file name structure as "Original File name -
Exported Files sheet name". Then close all Exported files, but leave
the Parent file still open

What is happening is that there is only 1 Exported file being created
(but instead of having data relevant to the specific manager it shows
all data with no subtotals), this is then being saved and closed, as
is the parent, but whats left open is the same Exported file, with
subtotals etc although its not named. It doesn't create any of the
other 3 expected filtered files

I see.

Option Explicit
Sub ExtractAMs()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Long
Dim c As Range
Dim LastRow As Long
Dim myFileName As String

Application.ScreenUpdating = False

Set ws1 = Sheets("2007")

With ws1
.Range("R:IV").Delete

'rebuild it each time???
Call InsertAMName

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A12:r" & LastRow)

'extract a list of unique managers in column Y
.Range("r12:r" & LastRow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), _
Unique:=True

r = Cells(.Rows.Count, "Y").End(xlUp).Row

For Each c In Range("Y2:Y" & r).Cells
'workbooks.add(1) creates a new workbook with a single Sheet
'workbooks.add(1).worksheets(1) is that sheet
Set wsNew = Workbooks.Add(1).Worksheets(1)
wsNew.Name = c.Value

'build the criteria range in X1:X2
.Range("x1").Value = .Range("y1").Value
.Range("x2").Value = "=" & Chr(34) & "=" & c.Value & Chr(34)

.Rows("1:11").Copy _
Destination:=wsNew.Range("a1")

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A12"), _
Unique:=False

.Columns("A:Q").Copy

With wsNew
.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
.Parent.Activate
.Select
ActiveWindow.Zoom = 75
ActiveWindow.DisplayGridlines = False
.Range("A1").Select
.Range("R:iv").Delete

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

.Range("A12:Q" & LastRow).Subtotal _
GroupBy:=2, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

myFileName = c.Parent.Parent.FullName
myFileName = Left(myFileName, Len(myFileName) - 4)
myFileName = myFileName & " - " & c.Value & ".xls"

Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
.Parent.Close savechanges:=False
End With
Next c
End With

ws1.Parent.Activate
ws1.Select
ws1.Columns("R:IV").Delete

End Sub
Sub InsertAMName()
Dim LastRow As Long
Application.ScreenUpdating = False
With Worksheets("2007")
'add a header for column R in Row 12
.Range("R12").Value = "Manager"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
.Range("R13:R" & LastRow).Formula _
= "=VLOOKUP(B13,AM_Lookup,2,false)"
End With
End Sub

=======
This line

..parent.saveas ...
refered to the object in the previous With statement (without a corresponding
End With statement).

In the other code, the object in the previous with statement was WS1
(worksheets("2007")).

I rearranged the code a bit just to clean it up a bit--now .parent.saveas refers
to wsnew.


Sean wrote:

The save routine is not quite what I was looking for. I'm looking to
have the exported/filtered files saved into the same location as the
parent file, with a file name structure as "Original File name -
Exported Files sheet name". Then close all Exported files, but leave
the Parent file still open

What is happening is that there is only 1 Exported file being created
(but instead of having data relevant to the specific manager it shows
all data with no subtotals), this is then being saved and closed, as
is the parent, but whats left open is the same Exported file, with
subtotals etc although its not named. It doesn't create any of the
other 3 expected filtered files

--

Dave Peterson

That code works exactly how I want it Dave, thanks

Whew!

Glad it's working.

Sean wrote:

That code works exactly how I want it Dave, thanks

--

Dave Peterson