VBA to filter on a single value in multiple columns and display only those rows

[Coenieh]

Hi All,

I have a spreadsheet with multiple columns, with Columns "F", "I" and "L" listing scheduled jobs (SJ) and Columns "G", "J" and "M" listing work sites (WS) for the SJ. So, Columns "F" and "G" will define a SJ and a WS and Col "I" and "J" the next SJ and WS etc. These 3 columns "G", "J" and "M" might have the same WS listed, but in different rows depending on the sequence the jobs are allocated in as well as the date, which leads to my problem, I want to display only the rows that contain a specific WS, in all of the three columns. Filtering only shows the the WS in one column and I therefore do not see all jobs for a specific site.

Below is an example of the spreadsheet, which might assist in the explanation, e.g. I want to filter on BEL in the Site columns and display all rows containing BEL and also including the Headers.

C	D	E	F	G	H	I	J	K	L	M	N
Date	Month	Year	Job 1	Site 1	Venue 1	Job 2	Site 2	Venue 2	Job 3	Site 3	Venue 3
1/10/2018	OCT	2018	HT	BEL		F5M	GKH		LT	JCH
2/10/2018	OCT	2018	MHT	MHH		LT	BEL		HT	GKH
3/10/2018	OCT	2018	F5M	JCH		HT	MHH		F5M	BEL
4/10/2018	OCT	2018	LT	GKH		F5M	MHH		MHT	JCH

<tbody>
</tbody>

Any help with VBA to assist with displaying only the rows that contain a specific work site in any of the columns and hiding all that does not meet the criteria, will be appreciated. I was thinking on a reference cell, where the relevant work site could be selected from a drop down list to filter on or alternatively a button for each work site to run VBA

I not sure if I have explained this well enough, but please let me know should you require any further

Kind Regards

 

[vcoolio]

Hello Coenieh,

Perhaps the following may help.

Let's assume that you have created a drop down in cell O1 with all the work site names listed. The work site names in this drop down must be spelt exactly as they are spelt in the data set.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("O1")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

      Dim lr As Long
      lr = Range("C" & Rows.Count).End(xlUp).Row
      
Application.ScreenUpdating = False

      Range("Z2:Z" & lr) = "=ISERROR(MATCH(O$1,C2:M2,0))"
      Range("Z1", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 1, False
      
Application.ScreenUpdating = True

End Sub

The code is a Worksheet_Change event and needs to be placed in the sheet module. To implement this code:-

- Right click on the sheet tab.
- Select "View Code" from the menu that appears.
- In the big white code field that then appears, paste the above code.

This code uses a helper column (Z) into which it places a formula to check whichever row the work site name appears (selected from the drop down in O1) and then filters on "False". Once you click away from cell O1, or press enter or down arrow, the relevant rows are then displayed.

In a standard module, place the following code and assign it to a button placed somewhere on your worksheet:-

Sub FilterOff()
      
      Sheet1.[Z1].AutoFilter
      Sheet1.Columns(26).Clear
      
End Sub

This code will turn off the filter when you are ready to do so and will clear Column Z.

I hope that this helps.

Cheerio,
vcoolio.

 

[Coenieh]

Hello vcoolio,

Thank you so much for your quick response and solution, I really appreciate your effort. I will test your solution once I am back at work, I am away for two days, and give you feedback. Have a great day.

Kind Regards

Coenieh

 

[Coenieh]

Hi vcoolio,

Thanks for your solution really appreciate your help, I have managed to get the macro to work with some tweaking, please see below. I have also added a line of code to disable the button which clears the Filter as it causes an error if clicked a second time and also to reactivate it.

I have created my drop down in "G2" for the Site Names. If I wanted to filter on either the sites or the "Months" in column "D", how would I go about adapting the code to achieve this?. I created a drop down in "G3" to select the months from, but cannot get it to work

Private Sub Worksheet_Change(ByVal Target As Range)


    If Intersect(Target, Range("G2")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub


          Dim lr As Long
          lr = Range("B" & Rows.Count).End(xlUp).Row


    Application.ScreenUpdating = False


          Range("Z7:Z" & lr) = "=ISERROR(MATCH(G$2,B7:O7,0))"
          Range("Z7", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 1, False


    Application.ScreenUpdating = True
    Call activate_button_31




End Sub

Apologies if I'm bugging you too much.

Kind Regards

Coenieh

 

[vcoolio]

Hello Coenieh,

Try it as follows:-

A) Place all the following codes in a standard module:-

Sub FilterOff()
      
      On Error Resume Next
      Sheet1.[Z1].AutoFilter  '----> Change to suit.
      Sheet1.Columns(26).Clear  '----> Change to suit.
      
End Sub

Sub FilterData1(ByVal Target As Range)

    Dim rng As Range
    Dim lr As Long
    Set rng = Intersect(Range("O1"), Target)  '---->Change the range to suit.
    If rng Is Nothing Then Exit Sub
    lr = Range("C" & Rows.Count).End(xlUp).Row  '---->Change C to B?
      
Application.ScreenUpdating = False

    Range("Z2:Z" & lr) = "=ISERROR(MATCH(O$1,C2:M2,0))"   '---->Change range to suit.
    Range("Z1", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 1, False   '---->Change range to suit.
      
Application.ScreenUpdating = True

End Sub

Sub FilterData2(ByVal Target As Range)

    Dim rng As Range
    Set rng = Intersect(Range("N1"), Target)  '----> Change range to suit.
    If rng Is Nothing Then Exit Sub
    
Application.ScreenUpdating = False

    Range("D1", Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, rng   '---->Change range to suit.
    
Application.ScreenUpdating = True

End Sub

B) Place the following code into the sheet module:-

Private Sub Worksheet_Change(ByVal Target As Range)
 
Application.EnableEvents = False
  
    On Error Resume Next

    FilterData1 Target
    FilterData2 Target
 
Application.EnableEvents = True

End Sub

This will enable you to filter as per my post #2 (or your post #4 ) and also will enable you to filter on the months once a month value is placed in cell N1. The month values need to be spelt exactly the same in the drop down that you create as they are in Column D.

As you can see, I've written the above codes using the same references as in post #2 so I'll leave you with some homework to tweak the references to suit yourself.

You may notice that I've added a little error trapper in the "Filter Off" code so if the "Filter Off" button is pressed more than once unnecessarily, nothing will happen.

I hope that this helps.


Cheerio,
vcoolio.

 

[vcoolio]

Hello again Coenieh,

Here's another method that may suit you more:

I was thinking that you may want to filter on the months whilst the work sites are currently filtered. For example, say you have filtered on work site "BEL" but this work site has different months attached to it (say Oct, Nov, Dec....) but you only want to analyse the site for October then the following code placed in the worksheet module should do this for you:-

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Dim lr As Long: lr = Range("C" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Range("O1")) Is Nothing Then
      Range("Z2:Z" & lr) = "=ISERROR(MATCH(O$1,C2:M2,0))"
      Range("Z1", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 1, False
End If

If Not Intersect(Target, Range("N1")) Is Nothing Then
      AutoFilterMode = False
      Range("D1", Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, Target
End If

End Sub

The "Filter Off" code remains in the standard module.

With this code, you'll need to filter on the work site first then the month. It will still allow you to filter on just the month if that is what you require.

Again, you'll need to change the cell/range references to suit yourself.

I hope that this helps.

Cheerio,
vcoolio.

 

[Coenieh]

Hi vcoolio

You are a superstar, both worked like a charm. Thanks again for your help, it is much appreciated. If only I could manage a 10th of what you did in such short time....

Kind Regards
Coenieh

 

[vcoolio]

Hello Coenieh,

You're welcome. I'm happy to have been able to help.

Thank you for the kind feed-back.

Cheerio,
vcoolio.