#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 45
Default Help me4

Hi all
please help me, i want to filter three columns pubid=0877,
royalty=10, and then type=trad_cook
i've recorded the following, my problem is if i know the column name
only not column no. And can you can you minimise the code.
Sub macro3()
Activecell.Rows("1:1").Entirerow.Select
Selection.Autofilter
Activecell.offset(0,3).range("a1").select
activesheet.range("$a$1:$j$19").autofilter field:=4, criteria1="0877"
Activecell.offset(0,3).range("a1").select
activesheet.range("$a$1:$j$19").autofilter field:=7, criteria1="10"
Activecell.offset(0,-4).range("a1").select
activesheet.range("$a$1:$j$19").autofilter field:=3,
criteria1="trad_cook"
Activecell.offset(0,-2).range("a1:j19").select
activecell.activate
selection.copy
sheets("filtereddata").select
activesheet.paste
application.cutcopymode=false
end sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 173
Default Help me4

Timothy,

I think from your posts that you are looking for a way to filter your data down to only the records meeting certain criteria. Advanced filter is a great way to do this. The macro below will take your data range and filter it based on three columns. Then it will paste that data to a new sheet.

Hope this helps,
Ben


Sub FilterResults()
Dim DataRange As Range
Dim Destination As Worksheet

Set DataRange = Sheet1.Range("A1:D20") 'Where your data is
Set Destination = ThisWorkbook.Sheets.Add 'New sheet to store results

DataRange.Range("A1").EntireRow.Copy Destination.Range("A1") 'Copy headers
ThisWorkbook.Names.Add Name:="Data", _
RefersTo:="='" & Sheet1.Name & "'!" & DataRange.Address 'Add named range
Destination.Range("A1:D1").EntireColumn.Insert (xlToRight) 'Insert columns for criteria
With Destination.Range("A1")
.Value = "pubid" 'Criteria 1 column header
.Offset(1, 0).Value = "'=0877" 'Criteria 1 value
.Offset(0, 1).Value = "royalty" 'Criteria 2 column header
.Offset(1, 1).Value = "'=10" 'Criteria 2 value
.Offset(0, 2).Value = "type" 'Criteria 3 column header
.Offset(1, 2).Value = "'=trad_cook" 'Criteria 3 value
End With
Range("Data").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Destination.Range("A1:C2"), _
CopyToRange:=Destination.Range("E1").CurrentRegion , _
Unique:=False 'Filter results using criteria
Destination.Range("A:D").Delete 'Delete criteria range
Destination.Activate

End Sub
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,522
Default Help me4

On Wednesday, September 19, 2012 12:04:26 AM UTC-5, TIMOTHY wrote:
Hi all

please help me, i want to filter three columns pubid=0877,

royalty=10, and then type=trad_cook

i've recorded the following, my problem is if i know the column name

only not column no. And can you can you minimise the code.

Sub macro3()

Activecell.Rows("1:1").Entirerow.Select

Selection.Autofilter

Activecell.offset(0,3).range("a1").select

activesheet.range("$a$1:$j$19").autofilter field:=4, criteria1="0877"

Activecell.offset(0,3).range("a1").select

activesheet.range("$a$1:$j$19").autofilter field:=7, criteria1="10"

Activecell.offset(0,-4).range("a1").select

activesheet.range("$a$1:$j$19").autofilter field:=3,

criteria1="trad_cook"

Activecell.offset(0,-2).range("a1:j19").select

activecell.activate

selection.copy

sheets("filtereddata").select

activesheet.paste

application.cutcopymode=false

end sub


You will get more response if you try to use a meaningful subject line instead of "help" which is often ignored. Always give before and after examples of what you want along with code you have tried.
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

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



All times are GMT +1. The time now is 02:48 PM.

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"