VBA: Apply data filter to table column based on specific cell string

I am in need of desperate help. I have a basic understanding of VBA, but I'm certain what I want to do is pretty easy for an experienced programmer.

I have 2 worksheets (called "Search" and "(HIDDEN) RAW DATA").
> "Search" contains a drop-down list of values in cell F7.
> "(HIDDEN) RAW DATA" contains a table of data (F6:EH106). Column E7:E106 contains staff names. Row 6 of the table (F6:EH6) has headings which relate to specific skills. The same list of skills are held in a data validation list in F7 on the "Search" worksheet.

I want the VBA code to:

1. Read whatever skill has been chosen in cell F7 in Sheet "Search".
2. Search for the chosen skill in range F6:EH6 in Sheet "(HIDDEN) Raw Data".
3. Apply a Data Filter on the column header that matches F7, and filter out any blank rows.

I hope that is clear. I look forward to your response.


Stephen EdgerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

You say:
3. Apply a Data Filter on the column header that matches F7, and filter out any blank rows.

What do you mean by that ?
[ fanpages ]IT Services ConsultantCommented:
Hi Stephen,

The following code (stored within the code module of the [Search] worksheet, also within the attached workbook), assumes that each "Attribute" is unique; that is, no "Attribute" appears in more than one "Skill Area".

If this is an invalid assumption, then the code will needed amending accordingly.

Additionally, the use of (auto)filtering of the [(HIDDEN) RAW DATA] worksheet is not essential, but I have written the code to use this method (as per your instructions above).

However, if the blnAPPLY_FILTER constant value (that is presently set to True) is set to False, no filtering is used, & the outcome is still as requested.

I have also hidden the [(HIDDEN) Raw Data] worksheet in the attached workbook, to demonstrate the code executes as expected when the worksheet is in this visibility state.  You may "unhide" this worksheet, as desired.

Option Explicit

Private lngErr_Number                                   As Long
Private strErr_Description                              As String
Private Sub Worksheet_Change(ByVal Target As Range)

' -------------------------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/questions/28694303/VBA-Apply-data-filter-to-table-column-based-on-specific-cell-string.html ]
' Question Channel: Experts Exchange > Questions > VBA: Apply data filter to table column based on specific cell string
' Topic Area:       [ http://www.experts-exchange.com/topics/ms-excel/ ]
' ID:               Q_28694303
' Question Title:   VBA: Apply data filter to table column based on specific cell string
' Question Dated:   2015-07-02 03:31 PM
' Question Asker:   Stephen Edger
' Asker Profile:    [ http://www.experts-exchange.com/members/stephenedger.html ]
' Attachment:       [ http://filedb.experts-exchange.com/incoming/2015/07_w27/921572/Skills-Matrix.xlsx ]
' Solution posted:  5 July 2015 by fanpages
' Expert Profile:   [ http://www.experts-exchange.com/members/fanpages.html ] | [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2015 Clearlogic Concepts (UK) Limited                                            [ http://NigelLee.info ]
' -------------------------------------------------------------------------------------------------------------------------------

  Dim lngRow                                            As Long
  Dim objAttribute                                      As Range
  Dim objCell                                           As Range
  Dim objData_Headings_First                            As Range
  Dim objData_Headings_Row                              As Range
  Dim objFind                                           As Range
  Dim objName                                           As Range
  Dim objWorksheet_Data                                 As Worksheet
  Dim objWorksheet_Search                               As Worksheet
  On Error GoTo Err_Worksheet_Change
' *** NOTES ***

' The use of (auto)filtering of the [(HIDDEN) RAW DATA] worksheet is not essential.
' With the blnAPPLY_FILTER constant value set to True, the code will use filtering.
' However, if the blnAPPLY_FILTER value is set to False, no filtering is used.
' The outcome (the list of "Names" for the "Attribute" specified) is the same.

' Additionally, it is assumed that each "Attribute" is unique.
' That is, no "Attribute" appears in more than "Skill Area".
' If this is an invalid assumption, the code will need to be amended.

  Const blnAPPLY_FILTER                                 As Boolean = True               ' Set this to False if filtering of the [(HIDDEN) RAW DATA] worksheet is not required
  Const blnREMOVE_FILTER                                As Boolean = True               ' Set this to False if removal of the filter applied is not to be removed after searching
  Set objCell = Nothing                                                                 ' Initialise the working "Cell" range object, just to be tidy (but not strictly necessary)
  Set objFind = Nothing                                                                 ' Initialise the working "Find" range object, just to be tidy (but not strictly necessary)
  Set objWorksheet_Data = Worksheets("(HIDDEN) RAW DATA")                               ' The "data" worksheet that is to be searched for the specified "Attribute"
  Set objWorksheet_Search = Worksheets("Search")                                        ' The "search" worksheet where the "Attribute" is specified, & where "Name(s)" are returned
  Set objAttribute = objWorksheet_Search.Range("F7")                                    ' This cell on the [Search] worksheet that contains the "Attribute" to be searched
  Set objName = objWorksheet_Search.Range("F9")                                         ' The first cell on the [Search] worksheet where the "Name(s)" are to be returned
  Set objData_Headings_Row = objWorksheet_Data.Rows(6&)                                 ' The row of the "data" worksheet where filtering of the "Attribute" headings is to occur
  Set objData_Headings_First = objWorksheet_Data.Cells(objData_Headings_Row.Row, "F")   ' The cell of the "data" worksheet where the first "Attribute" heading is located
  If Target.Address = objAttribute.Address Then                                         ' Only execute the following code if the "Attribute" has been changed
     Set objFind = objWorksheet_Search.Range(objName, objWorksheet_Search.Cells(objWorksheet_Search.Rows.Count, Target.Column).End(xlUp))
     If objFind.Row >= objName.Row Then                                                 ' Clear any previously shown "Names"
     End If ' If objFind.Row >= objName.Row Then
     Set objFind = objData_Headings_Row.Find(What:=objAttribute, _
                                             After:=objData_Headings_First.Offset(, -1), _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=True, _
                                             SearchFormat:=False)                       ' Search for the "Attribute" specified within the headings
     If Not (objFind Is Nothing) Then                                                   ' Only execute the following code if the "Attribute" specified has been located
        If (blnAPPLY_FILTER) Then                                                       ' Only execute the following code if using the "Apply Filter" method
           If (objWorksheet_Data.FilterMode) Then                                       ' Remove any existing filters
           End If ' If (objWorksheet_Data.FilterMode) Then
           If Not (objWorksheet_Data.FilterMode) Then                                   ' Apply the filter to the headings row
              objWorksheet_Data.Range(objData_Headings_First, objData_Headings_First.End(xlToRight)).AutoFilter
           End If ' If Not (objWorksheet_Data.FilterMode) Then
           objWorksheet_Data.Range(objData_Headings_First, objData_Headings_First.End(xlToRight)).AutoFilter Field:=objFind.Column - objData_Headings_First.Column + 1, _
                                                                                                             Criteria1:="<>", _
        End If ' If (blnAPPLY_FILTER) Then
        Set objFind = objWorksheet_Data.Range(objFind.Offset(1&), objWorksheet_Data.Cells(objWorksheet_Data.Rows.Count, objFind.Column).End(xlUp)).SpecialCells(xlCellTypeVisible)
        lngRow = objName.Row - 1&                                                       ' Set the starting row at one row before where the first "Name" is to be returned
        For Each objCell In objFind                                                     ' Loop through each row for the "Attibute" & append each (non-blank) "Name" to the list
            If objCell.Row > objData_Headings_Row.Row Then                              ' Check if a "Name" is not the heading row (the actual name of the "Attribute")
               If Len(Trim$(objCell.Value)) > 0 Then
                  lngRow = lngRow + 1&                                                  ' Increment the row where the "Name" should be returned, so each Name is on a subsequent row
                  objWorksheet_Search.Cells(lngRow, objName.Column) = objWorksheet_Data.Cells(objCell.Row, objData_Headings_First.Column - 1).Value
               End If ' If Len(Trim$(objCell.Value)) > 0 Then
            End If ' If objCell.Row > objData_Headings_Row.Row Then
        Next objCell ' For Each objCell In objFind
     End If ' If Not (objFind Is Nothing) Then
  End If ' If Target.Address = objAttribute.Address Then


  On Error Resume Next
  If (blnREMOVE_FILTER) Then                                                            ' Remove any filters applied, if required
     If Not (objWorksheet_Data Is Nothing) Then
        If (objWorksheet_Data.FilterMode) Then
        End If ' If objWorksheet_Data.FilterMode Then
     End If ' If Not (objWorksheet_Data Is Nothing) Then
  End If ' If (blnREMOVE_FILTER) Then
' Release all memory used by the objects & return to calling process...

  Set objAttribute = Nothing
  Set objCell = Nothing
  Set objData_Headings_First = Nothing
  Set objData_Headings_Row = Nothing
  Set objFind = Nothing
  Set objName = Nothing
  Set objWorksheet_Data = Nothing
  Set objWorksheet_Search = Nothing
  Exit Sub

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  On Error Resume Next
  MsgBox "ERROR #" & CStr(lngErr_Number) & _
         vbCrLf & vbLf & _
         strErr_Description, _
         vbExclamation Or vbOKOnly, _
  Resume Exit_Worksheet_Change
End Sub

Open in new window

Incidentally, I applied for a freelance consultancy (contract-based) Microsoft Access/Visual Basic for Applications assignment at HSBC (in London) on 4 June 2015 (via a third party recruitment agency).  I did not receive any feedback from my application either from the agency, or from HSBC directly.

Will this "Skills Matrix" only be used to short-list internal candidates?  I have previously been involved with an MS-Excel/MS-Access project at HSBC (in late 2010/early 2011), & sourcing potential external resources known to the organisation may (also) benefit from this approach.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Stephen EdgerAuthor Commented:
I've requested that this question be deleted for the following reason:

I solved the problem a different way (without requiring vba)
Become a Microsoft Certified Solutions Expert

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

[ fanpages ]IT Services ConsultantCommented:
if Mr Edger wishes to close the question without even acknowledging the effort involved in providing a solution, then this is the last question of Mr Edger's I shall be responding to.

For that reason, I object.
@Stephen Edger
EE is a forum to answer questions but also ethics plays important role whereby when an expert give you a solution, the minimum is acknowledgment for the effort and time put. I will not add also that you did not even bother to answer my question but take it that you are new to this site and from my side you are forgiven.

Presume OP is new to EE as just started on Jul 2 which probably not fully aware of policy yet.

Stephen EdgerAuthor Commented:
Apologies all. I promise no offense was intended and I do appreciate the effort gone to by all. The truth is: having posted the question, on Thursday night I figured a way to solve my problem without needing vba. I am using a MATH and INDEX solution instead, which does exactly what I need.

I thought I should delete the question as it's no longer relevant, and I didn't want to waste anyone else's valuable time.
[ fanpages ]IT Services ConsultantCommented:
Thank you for your reply.

In future, if you change the requirements of your question say, on a Thursday evening, please do not leave the question open (asking for "VBA code") until Sunday evening.

The time has already been wasted, but the solution does not have to be.

I suggest the question is not deleted, but remains for anybody else to review & apply to their own workbooks, if required, in the future.
[ fanpages ]IT Services ConsultantCommented:
Thanks eenookami.

I will allow Mr Edger the opportunity to respond, but if this does not occur within the imposed time limit, I will comment again with a (further) suggestion for closure.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.