Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Problem with advanced filter macro
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 82
Default Problem with advanced filter macro
Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.
--
By persisting in your path, though you forfeit the little, you gain the
great.

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10,124
Default Problem with advanced filter macro
This may be easier to incorporate

Sub filterforpart()
With Range("H2:H22")
.AutoFilter Field:=1, Criteria1:="=*te*"
.Offset(1).Copy Range("k4")
.AutoFilter
End With
End Sub

or change your copy desination to suit
Sub filterforpartloop()
With Range("H2:H22")
Dim c
For Each c In Range("l2:l3")
.AutoFilter Field:=1, Criteria1:="=*" & c & "*"
.Offset(1).Copy c.Offset(, 1)
Next c
.AutoFilter
End With
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"DavidH56" wrote in message
...
Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out
text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please
see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.
--
By persisting in your path, though you forfeit the little, you gain the
great.


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Problem with advanced filter macro
I thiink you need to add an auxilarry formula. Use find to put a one in a
new column which you can use as a filter

=if(isErr(find(TE,A1)),0,1)



"DavidH56" wrote:

Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.
--
By persisting in your path, though you forfeit the little, you gain the
great.

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 82
Default Problem with advanced filter macro
Thanks for the quick response Joel.
I took yout advice and this is what I've placed in column Z:
=IF(ISERR(FIND(($U$2),A2)),0,1)
Now if you could help me with how to filter the 1's to create
separate new sheets.

Thank you.
--
By persisting in your path, though you forfeit the little, you gain the
great.



"Joel" wrote:

I thiink you need to add an auxilarry formula. Use find to put a one in a
new column which you can use as a filter

=if(isErr(find(TE,A1)),0,1)



"DavidH56" wrote:

Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.
--
By persisting in your path, though you forfeit the little, you gain the
great.

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Problem with advanced filter macro
Not sure which part of the code you want to filter since there are two places
where you have advance filter. You can use autofilter (I used column E) and
then copy the visible cells.


Columns("E").AutoFilter
Columns("E").AutoFilter Field:=1, Criteria1:="1"
Cells.SpecialCells(xlCellTypeVisible).Copy

field 1 is column E since only one column is spedified in the autofilter.


"DavidH56" wrote:

Thanks for the quick response Joel.
I took yout advice and this is what I've placed in column Z:
=IF(ISERR(FIND(($U$2),A2)),0,1)
Now if you could help me with how to filter the 1's to create
separate new sheets.

Thank you.
--
By persisting in your path, though you forfeit the little, you gain the
great.



"Joel" wrote:

I thiink you need to add an auxilarry formula. Use find to put a one in a
new column which you can use as a filter

=if(isErr(find(TE,A1)),0,1)



"DavidH56" wrote:

Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.
--
By persisting in your path, though you forfeit the little, you gain the
great.

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,979
Default Problem with advanced filter macro
Change your code to include asterisks with the criteria, as Don
suggested. In your code, the revised line would be:

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").Value = "*" & c.Value & "*" <===add asterisks


DavidH56 wrote:
Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.


--
Debra Dalgleish
Contextures
www.contextures.com/tiptech.html
Blog: http://blog.contextures.com

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 82
Default Problem with advanced filter macro
Thank you both Debra and Joel fo your response. I will test it and get back
with you on the results.

Once Again,
Thank you.
--
By persisting in your path, though you forfeit the little, you gain the
great.



"Debra Dalgleish" wrote:

Change your code to include asterisks with the criteria, as Don
suggested. In your code, the revised line would be:

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").Value = "*" & c.Value & "*" <===add asterisks


DavidH56 wrote:
Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.


--
Debra Dalgleish
Contextures
www.contextures.com/tiptech.html
Blog: http://blog.contextures.com


Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 82
Default Problem with advanced filter macro
Thanks you so much Debra,
This works to perfection. Thank you for your expertise and your time.
--
By persisting in your path, though you forfeit the little, you gain the
great.



"Debra Dalgleish" wrote:

Change your code to include asterisks with the criteria, as Don
suggested. In your code, the revised line would be:

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").Value = "*" & c.Value & "*" <===add asterisks


DavidH56 wrote:
Hello,

I've been trying to data extract to new sheets using Debra Danglish's
ExtractRep code. The code works great except for trying to filter out text
that is contained within cells sometimes behind other text. For instance I
want to filter TE out of DARFMTEA in row 3 and TERS45 in row 4. Please see
my code below.


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

'Create a list of Tank Criteria
'This is where I copy my range List to Column W.
'This list contains things like TE,RF, etc.. up to 30 items.
'I put in the header name in row one.
NameCrit

'ws1.Columns("W:W").Copy _
' Destination:=Range("Z1") '- only if you use the full list
ws1.Columns("W:W").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("U1"), Unique:=True
r = Cells(Rows.Count, "U").End(xlUp).Row

'set up Criteria Area
Range("W1").Value = Range("A1").Value

For Each c In Range("U2:U" & r)
'add the tank name to the criteria area
ws1.Range("W2").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("Summary").Range("W1:W2"), _
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("Summary").Range("W1:W2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("U:W").Delete
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

The my source column is column A.
Any help you provide would be greatly appreciated.


--
Debra Dalgleish
Contextures
www.contextures.com/tiptech.html
Blog: http://blog.contextures.com


Reply With QuoteReply With Quote
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,979
Default Problem with advanced filter macro
You're welcome, and thanks for letting me know that it worked.

DavidH56 wrote:
Thanks you so much Debra,
This works to perfection. Thank you for your expertise and your time.


--
Debra Dalgleish
Contextures
www.contextures.com/tiptech.html
Blog: http://blog.contextures.com

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Advanced Filter Problem Mustang Excel Discussion (Misc queries) 3 May 9th 09 08:28 AM
Advanced Filter problem R. Choate Excel Discussion (Misc queries) 14 May 28th 06 09:12 PM
Problem using Advanced filter anandmr65 Excel Discussion (Misc queries) 1 April 17th 06 10:14 AM
Advanced Filter problem SB Excel Programming 1 February 28th 05 12:37 PM
Problem in using Advanced Filter Shilps[_2_] Excel Programming 5 August 16th 04 09:22 PM


All times are GMT +1. The time now is 08:32 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement