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?

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

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