John,
Hope your feeling ok ...

How do I change this code to filter from Column "F" on cell "F26".

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

Many Thanks

"john" wrote:

Guessed right - miles off!
I'm about to get a tooth drilled but from what you are describing I think
this link will assist you. http://www.contextures.com/excelfiles.html
There is an example workbook you can download (FL0013) which you should be
able to adjust to your need.
--
jb


"manfareed" wrote:

Hi John,

I am having problems with this part of your code ... how do I spli it ?

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

.Range("F27:F" & LastRow).Sort Key1:=.Range("F27"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Column "F" contains the REgion Manager name.
Once sort is complete the rows with same region manager would need to be
copied to a new sheet. I hope thsi is clear.

Thanks,

Manir


"john" wrote:

not sure if I've fully understood what you are trying to do an mikes comment
aludes to lack of clear info.

As stab in the dark something along the lines of following may do what you
want? but there again, could be miles off!

Sub NewSheet()
Dim sh As Worksheet
Dim NewName As String


Application.ScreenUpdating = False

RN = 27
With ThisWorkbook.Worksheets("Sheet1") '<< change as required

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

.Range("F27:F" & LastRow).Sort Key1:=.Range("F27"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Do

NewName = .Range("F" & RN).Value

On Error Resume Next

Set sh = Worksheets(NewName)

On Error GoTo 0

If sh Is Nothing Then
Worksheets.Add.Name = (NewName)
End If

RN = RN + 1

Loop Until .Range("F" & RN).Value = ""

End With

Application.ScreenUpdating = True

End Sub

--
jb


"manfareed" wrote:

Hi ,

I need to sort data by column F [FROM F27]. Then create new sheets based on
each new name in column F.

Thanks