I have obtained a macro (AdvFilterRepFitered) that can create sheets with
records for each rep in filtered list (if a sheet already exists for a rep,
it will be cleared, and the data will be extracted to that sheet). It will
create sheets with rep's name.

How could modify it so the names for the created sheets will be C1, C2, C3,
C4 (not rep's name)...(depending on how many reps we have)

Any help will be appreciated.
--
Aline

Aline,

It would be best if you posted the code that you want modified.

HTH,
Bernie
MS Excel MVP


"Aline" <(E-Mail Removed)> wrote in message
news:AA92E9DC-C476-491D-B565-(E-Mail Removed)...
>I have obtained a macro (AdvFilterRepFitered) that can create sheets with
> records for each rep in filtered list (if a sheet already exists for a rep,
> it will be cleared, and the data will be extracted to that sheet). It will
> create sheets with rep's name.
>
> How could modify it so the names for the created sheets will be C1, C2, C3,
> C4 (not rep's name)...(depending on how many reps we have)
>
> Any help will be appreciated.
> --
> Aline

Here is the codes:

***
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

***

Thanks,
Aline



--
Aline


"Aline" wrote:

> I have obtained a macro (AdvFilterRepFitered) that can create sheets with
> records for each rep in filtered list (if a sheet already exists for a rep,
> it will be cleared, and the data will be extracted to that sheet). It will
> create sheets with rep's name.
>
> How could modify it so the names for the created sheets will be C1, C2, C3,
> C4 (not rep's name)...(depending on how many reps we have)
>
> Any help will be appreciated.
> --
> Aline

Try this version:


HTH,
Bernie
MS Excel MVP

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim myC As Integer

Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")
myC = 0

'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)
myC = myC + 1
wsNew.Name = "C" & myC
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






"Aline" <(E-Mail Removed)> wrote in message
newsA9209D7-D2CB-490B-98F4-(E-Mail Removed)...
> Here is the codes:
>
> ***
> 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
>
> ***
>
> Thanks,
> Aline
>
>
>
> --
> Aline
>
>
> "Aline" wrote:
>
>> I have obtained a macro (AdvFilterRepFitered) that can create sheets with
>> records for each rep in filtered list (if a sheet already exists for a rep,
>> it will be cleared, and the data will be extracted to that sheet). It will
>> create sheets with rep's name.
>>
>> How could modify it so the names for the created sheets will be C1, C2, C3,
>> C4 (not rep's name)...(depending on how many reps we have)
>>
>> Any help will be appreciated.
>> --
>> Aline