Filtering on specific values contained in column

[JulieO]

Column A
Row1 Orange-Apple-Pear
Row2 Orange-Grapes-Melon
Row3 Berry-Apple-Melon
Row4 Banana-Grapes-Melon
Row5 Orange-Grapes-Banana
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Given the information above:
<o> </o>
I want to find a macro that will auto filter on for example
“Banana” would filter to rows 4,5
“Orange” would filter to rows 1,2,5
“Apple” would filter to rows 1,3
<o> </o>
Any suggestions?

 

[Trevor G]

This would work, adjust for the other variable names

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> mcrFilter()<br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">' mcrFilter Macro</SPAN><br><SPAN style="color:#007F00">'</SPAN><br><br><SPAN style="color:#007F00">'</SPAN><br>    Selection.AutoFilter<br>    ActiveSheet.Range("$A$1:$A$6").AutoFilter Field:=1, Criteria1:="=*Banana*" _<br>        , Operator:=xlAnd<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[JulieO]

There is a variable that is defines the list of fruit:

LetFruit= Column A & Counter

I'm filtering on those values and copy and pasting the data into new files and saving. So I need to filter on each fruit and create three new files. I have the code fo the pasting and saving. Thanks

 

[MickG]

Place your data in column "A" Range "A2" on.
Right click your sheet Tab, Select "View Code"
VB Window appears.
Paste the entire code below into the VB Window.
Close VB window.
Activate another sheet.
Activate the original sheet.
"B1" should now have a "Drop down" List of the Individual Items in column "A".
Select one of the items.
Rows in column "A" hidden as appropriate.

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Activate()
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oFrt [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count * 5)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    oFrt = Split(Dn, "-")
        [COLOR="Navy"]For[/COLOR] Rw = 0 To UBound(oFrt)
            [COLOR="Navy"]If[/COLOR] Not .Exists(oFrt(Rw)) [COLOR="Navy"]Then[/COLOR] .Add oFrt(Rw), ""
        [COLOR="Navy"]Next[/COLOR] Rw
 [COLOR="Navy"]Next[/COLOR] Dn
Range("F1").Resize(.Count) = Application.Transpose(.Keys)
[COLOR="Navy"]Set[/COLOR] oRng = Range("F1").Resize(.Count)
[COLOR="Navy"]End[/COLOR] With
Range("B1").Select
[COLOR="Navy"]With[/COLOR] Selection.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=" & oRng.Address & ""
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] InStr(Dn, Target) = 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Hidden = True
[a1].Select
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR="Navy"]Then[/COLOR]
    Columns("A:A").EntireRow.Hidden = False
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[JulieO]

Thanks!