Filter multiple columns for two words

[tinejf]

Hi,
I need help to filter multiple columns for two words at the same time. I have added and example. Here are the info:

There is a heading on row 1 and 2, and other information on in column A to F. The columns that I want to filter is between G and N and rows down is undefined. Columns after S is empty.
Here is a table to use as an example:

Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8
Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND
John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold
Charles	Link	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought
Karen	Hero	RND	Sold	Bought	Bought	Bought	Bought	Bought	Sold
Dennis	Letgo	TBN	TBN	TBN	Bought	Bought	Bought	Bought	TBN
Angela	Greatso	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought
Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND

I want to filter all the rows containing "RND" or "Sold" or both in columns G to N, and hide the rows not containing "RND" and "Sold".

I previously recieved this macro code from @Peter_SSs which worked well (ref: Filter multiple columns for a single word) but I can't figure out how to use it for multiple words:

Sub Show_My_Rows_of_Interest()
  Dim rCrit As Range
 
  Const TextOfInterest As String = "RND"
  Const ColsOfInterest As String = "F:N"
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With ActiveSheet
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    Set rCrit = .Range("Z1:Z2")
    With Intersect(.UsedRange, .Columns(ColsOfInterest))
      rCrit.Cells(2).Formula = Replace(Replace("=COUNTIF(#,""*%*"")", "#", .Rows(2).Address(0, 0)), "%", TextOfInterest)
      .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    End With
    rCrit.Cells(2).ClearContents
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Thank you, in advance!

 

[kevin9999]

I'm a bit unclear as to the actual layout of your data - it would be so much simpler if you could provide a sample of your sheet using the XL2BB add in. Having said that, try the following code on a copy of your data. The before & after results are posted below. Is this what you're after?

Option Explicit
Sub Multi_Column_Filter()
    Dim ws As Worksheet, LCol As Long, LRow As Long
    Set ws = Worksheets("Sheet1")           '<<~~ Change to actual sheet name ***
    
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    Dim a, b, i As Long, j As Long
    a = ws.Range(ws.Cells(3, 7), ws.Cells(LRow, LCol - 1))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(a, 2)
            If a(i, j) = "RND" Or a(i, j) = "Sold" Then b(i, 1) = 1
        Next j
    Next i
    ws.Cells(3, LCol).Resize(UBound(b, 1)).Value2 = b
    
    Dim Rdata As Range, Rcrit As Range
    Set Rdata = ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol - 1)).Resize(, LCol)
    Set Rcrit = ws.Range(ws.Cells(2, LCol + 1), ws.Cells(3, LCol + 1))
    Rcrit.Cells(1).Offset(, -1).Resize(, 2).Value2 = "X"
    Rcrit.Cells(2) = 1
    
    With Rdata
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Rcrit, Unique:=False
    End With
    
    ws.Columns(LCol).Resize(, 2).EntireColumn.ClearContents
End Sub

Before:

Multi Filter.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8	Notes9	Notes10	Notes11	Notes12	Notes13	Notes14	Notes15	Notes16	Notes17
3	Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND	Sold	RND	RND	RND	RND	RND	RND	Sold	RND
4	John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold
5	Charles	Link	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought	Bought	Bought
6	Karen	Hero	RND	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought
7	Dennis	Letgo	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	Bought	TBN	TBN	TBN
8	Angela	Greatso	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought
9	Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold
10
Sheet1

After:

Multi Filter.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8	Notes9	Notes10	Notes11	Notes12	Notes13	Notes14	Notes15	Notes16	Notes17
3	Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND	Sold	RND	RND	RND	RND	RND	RND	Sold	RND
4	John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold
6	Karen	Hero	RND	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought
8	Angela	Greatso	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought
9	Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold
10
Sheet1

 

[tinejf]

Hi @kevin9999,
This worked perfectly, thank you so much! :D

I realized that it would also be preferable to have the option of showing only the rows including both "RND" and "Sold", are you also able to help me with that?
Thank you, in advance!

- Tine

 

[kevin9999]

This worked perfectly, thank you so much! :D

Happy to have helped, and thank you for the feedback

I realized that it would also be preferable to have the option of showing only the rows including both "RND" and "Sold"

Try the following:

Option Explicit
Sub Multi_Column_Filter_RND_and_Sold()
    Dim ws As Worksheet, LCol As Long, LRow As Long
    Set ws = Worksheets("Sheet1")           '<<~~ Change to actual sheet name ***
    
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    Dim a, b, i As Long, j As Long, k As Long, x As Long
    a = ws.Range(ws.Cells(3, 7), ws.Cells(LRow, LCol - 1))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    For i = 1 To UBound(a, 1)
        k = 0: x = 0
        For j = 1 To UBound(a, 2)
            If a(i, j) = "RND" Then k = k + 1
            If a(i, j) = "Sold" Then x = x + 1
        Next j
        If k > 0 And x > 0 Then b(i, 1) = 1
    Next i
    
    ws.Cells(3, LCol).Resize(UBound(b, 1)).Value2 = b
    
    Dim Rdata As Range, Rcrit As Range
    Set Rdata = ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol - 1)).Resize(, LCol)
    Set Rcrit = ws.Range(ws.Cells(2, LCol + 1), ws.Cells(3, LCol + 1))
    Rcrit.Cells(1).Offset(, -1).Resize(, 2).Value2 = "X"
    Rcrit.Cells(2) = 1
    
    With Rdata
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Rcrit, Unique:=False
    End With
    
    ws.Columns(LCol).Resize(, 2).EntireColumn.ClearContents
End Sub

Before:

tinejf.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8	Notes9	Notes10	Notes11	Notes12	Notes13	Notes14	Notes15	Notes16	Notes17
3	Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND	Sold	RND	RND	RND	RND	RND	RND	Sold	RND
4	John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold
5	Charles	Link	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought	Bought	Bought
6	Karen	Hero	RND	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought
7	Dennis	Letgo	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	Bought	TBN	TBN	TBN
8	Angela	Greatso	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought
9	Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold
10
Sheet1

After:

tinejf.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8	Notes9	Notes10	Notes11	Notes12	Notes13	Notes14	Notes15	Notes16	Notes17
3	Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND	Sold	RND	RND	RND	RND	RND	RND	Sold	RND
4	John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold
9	Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold
10
Sheet1

 

[tinejf]

Happy to have helped, and thank you for the feedback


Try the following:

Option Explicit
Sub Multi_Column_Filter_RND_and_Sold()
    Dim ws As Worksheet, LCol As Long, LRow As Long
    Set ws = Worksheets("Sheet1")           '<<~~ Change to actual sheet name ***
   
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
   
    Dim a, b, i As Long, j As Long, k As Long, x As Long
    a = ws.Range(ws.Cells(3, 7), ws.Cells(LRow, LCol - 1))
    ReDim b(1 To UBound(a, 1), 1 To 1)
   
    For i = 1 To UBound(a, 1)
        k = 0: x = 0
        For j = 1 To UBound(a, 2)
            If a(i, j) = "RND" Then k = k + 1
            If a(i, j) = "Sold" Then x = x + 1
        Next j
        If k > 0 And x > 0 Then b(i, 1) = 1
    Next i
   
    ws.Cells(3, LCol).Resize(UBound(b, 1)).Value2 = b
   
    Dim Rdata As Range, Rcrit As Range
    Set Rdata = ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol - 1)).Resize(, LCol)
    Set Rcrit = ws.Range(ws.Cells(2, LCol + 1), ws.Cells(3, LCol + 1))
    Rcrit.Cells(1).Offset(, -1).Resize(, 2).Value2 = "X"
    Rcrit.Cells(2) = 1
   
    With Rdata
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Rcrit, Unique:=False
    End With
   
    ws.Columns(LCol).Resize(, 2).EntireColumn.ClearContents
End Sub

Before:

tinejf.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8	Notes9	Notes10	Notes11	Notes12	Notes13	Notes14	Notes15	Notes16	Notes17
3	Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND	Sold	RND	RND	RND	RND	RND	RND	Sold	RND
4	John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold
5	Charles	Link	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought	Bought	Bought	Bought	TBN	TBN	TBN	Bought	Bought	Bought
6	Karen	Hero	RND	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought	Bought	Bought	Bought	Bought	Sold	Sold	Bought
7	Dennis	Letgo	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	TBN	Bought	TBN	TBN	TBN
8	Angela	Greatso	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought	Bought	Bought	Bought	Sold	Bought	Sold	Bought
9	Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold
10
Sheet1

After:

tinejf.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Name	Company	Notes	Notes2	Notes3	Notes4	Notes5	Notes6	Notes7	Notes8	Notes9	Notes10	Notes11	Notes12	Notes13	Notes14	Notes15	Notes16	Notes17
3	Mike	Sky	Sold	Sold	RND	RND	RND	RND	RND	RND	Sold	RND	RND	RND	RND	RND	RND	Sold	RND
4	John	Glow	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold	Sold	Bought	Bought	RND	Sold	RND	Sold
9	Paul	Marshmellow	Sold	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold	Sold	Sold	Sold	RND	RND	Bought	Sold
10
Sheet1

Thank you for the quick reply and for the solution!
This worked perfectly aswell

- Tine