Excel - Search & Display query

December 2016




Issue


I am a non IT person.. I have a simple requirement, but dont know how to go about.

The requirement is

My data. 
Sno Release Project Contact persons 
1 Apr SYL Sam, Mark, Tom 
2 May Xim Tom, Frank, Kim 
3 June TIG Kim, David, Sam 


My requirement is when I search by project or by release,, I need to get all the contact person names.. The same way if I search by contact person name.. E.g. Sam in the above example.. The excel has to show me all the projects that Sam was involved with all the relevant data like Release etc...This has to be displayed in a new sheet in excel.

Is it possible to do in Excel or I need to try something else? Can you help me in doing this?

Solution


Assumptions:
  • 1. Name of the sheet where the data is "Sheet1" (correct the code if its not)
  • 2. Name of the sheet where the search result are to be pasted is "Result" (correct the code if its not)
  • 3. Previous search results are to be discarded
  • 4. Data is on 4 columns ( as in sample)



STEPS:
  • 1. Read Assumptions
  • 2. Make a back up
  • 3. Press ALT + F11 at the same time to enter VBE environment
  • 4. Click on "Insert" and add a new module
  • 5. Paste the code ( after the instructions)
  • 6. Run the code


Code:


Sub SearchData()  

Dim lMaxRows As Long 'max number of rows of data based on cells used on column A  
Dim lFilterRows As Long 'last filtered row  

Dim searchRel As Variant 'what is to be search for Release Info  
Dim searchProj As Variant 'what is to be search for Project Info  
Dim searchPpl As Variant 'what is to be search for Contact Info  

Dim sDataSheet As String 'name of the data sheet  
Dim sResultSheet As String 'name of the result sheet  

    sDataSheet = "Sheet1" 'name of the data sheet  
    sResultSheet = "Result" 'name of the result sheet  
      
    'getting search criteria  
    searchRel = InputBox("What Release you want to search. To skip, just press OK.")  
    searchProj = InputBox("What Project you want to search. To skip, just press OK.")  
    searchPpl = InputBox("Which contact person you want to search. To skip, just press OK.")  
      
    'remove white spaces  
    searchRel = Trim(searchRel)  
    searchProj = Trim(searchProj)  
    searchPpl = Trim(searchPpl)  
      
    ' if all three search criteria are blank then dont do any thing  
    If (Len(searchRel & searchProj & searchPpl) = 0) Then Exit Sub  
      
    On Error Resume Next  
      
        Application.DisplayAlerts = False  
        'delete previous result sheet if it exists  
        Sheets(sResultSheet).Delete  
        Application.DisplayAlerts = True  
          
    On Error GoTo 0  
      
    'adding the result sheet  
    Sheets.Add  
    ActiveSheet.Name = sResultSheet  
      
    Sheets(sDataSheet).Select  
    Cells.Select  
      
    'removing any filter  
    If ActiveSheet.AutoFilterMode Then  
          
        On Error Resume Next  
          
        ActiveSheet.ShowAllData  
          
        On Error GoTo 0  
      
    End If  
      
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row  
      
    If ActiveSheet.AutoFilterMode = False Then  
        Selection.AutoFilter  
    End If  
      
      
    If (searchRel) <> "" Then  
        Selection.AutoFilter Field:=2, Criteria1:="=" & searchRel, Operator:=xlAnd, Criteria2:="<>"  
    End If  
      
    If (searchProj) <> "" Then  
        Selection.AutoFilter Field:=3, Criteria1:="=" & searchProj, Operator:=xlAnd, Criteria2:="<>"  
    End If  
      
    If (searchPpl) <> "" Then  
        Selection.AutoFilter Field:=4, Criteria1:="=*" & searchPpl & "*", Operator:=xlAnd, Criteria2:="<>"  
    End If  
      
    lFilterRows = Cells(Rows.Count, "A").End(xlUp).Row  
      
      
    Range("A1:D" & lFilterRows).Copy  
      
    Sheets(sResultSheet).Select  
      
    Range("A1").Select  
    ActiveSheet.Paste  

    Sheets(sDataSheet).Select 
    Cells.Select 
     
    'removing any filter 
    If ActiveSheet.AutoFilterMode Then 
         
        On Error Resume Next 
         
        ActiveSheet.ShowAllData 
         
        On Error GoTo 0 
     
    End If 

End Sub  

Note


Thanks to rizvisa1 for this tip on the forum.

Related :

This document entitled « Excel - Search & Display query » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.