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
CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.
