Macro to filter multiple columns simultaneously

[Joby]

Hi,

I m a newbie to this, Need help to filter multiple columns using input boxes with 4 different criterias at one go using vba macro and paste onto a new sheet.

Here's a sample Data

col-A col-B col-C col-D col-E col-F
SPOC RECNAME DOBIRTH QUALIFICATION DORESG UNIV
Rajeev Manoj 12-06-1981 BSC 10-04-06 Mumbai
Naveen Vinod 04-05-1980 BCom 19-08-09 Mumbai
Shree Ramesh 17-05-1984 MBA 21-05-07 Mumbai
....
We have this kind of data for approx 5000 rows,

Now here's what I need
From the above data on sheet1 I need to filter on the first four columns

I need to auto fileter on the criteria's as mentioned in the input box. The input box will be for user to enter desired filtering option to fileter on the specific coulmn. He can select all or any of the options or only one option leaving other boxes blank. Depending on the input in the box the macro should then filter on all the required columns and pull the information to a nes sheet say Sheet2

Say for instance I need
SPOC : Rajeev
RECNAME : Manoj
DOBIRTH : 12-06-1981
QUALIIFCATION : BSC

I hope I have given all information. In case if anyone needs more data I can help them out. Please if anyone can help me with it will be great.

Thnaks & Regards
Joby

 

[venkat1926]

In my regional preference the date is entered as mm/dd/yy so your database looks in my sheet as

<table x:str="" style="border-collapse: collapse; width: 499pt;" width="665" border="0" cellpadding="0" cellspacing="0"><col style="width: 130pt;" width="173"> <col style="width: 81pt;" width="108"> <col style="width: 72pt;" width="96" span="4"> <tbody><tr style="height: 19.5pt;" height="26"> <td class="xl23" style="height: 19.5pt; width: 130pt;" width="173" height="26"> <table x:str="" style="border-collapse: collapse; width: 499pt;" width="665" border="0" cellpadding="0" cellspacing="0"><col style="width: 130pt;" width="173"> <col style="width: 81pt;" width="108"> <col style="width: 72pt;" width="96" span="4"> <tbody><tr style="height: 19.5pt;" height="26"> <td class="xl25" style="height: 19.5pt; width: 130pt;" width="173" height="26">SPOC</td> <td style="width: 81pt;" width="108">RECNAME</td> <td style="width: 72pt;" width="96">DOBIRTH</td> <td style="width: 72pt;" width="96">QUALIFICATION</td> <td style="width: 72pt;" width="96">DORESG</td> <td style="width: 72pt;" width="96">UNIV</td> </tr> <tr style="height: 19.5pt;" height="26"> <td style="height: 19.5pt;" height="26">Rajeev</td> <td>Manoj</td> <td class="xl24" x:num="29749" align="right">6/12/1981</td> <td>BSC</td> <td class="xl24" x:str="'10-4-2006">10-4-2006</td> <td>Mumbai</td> </tr> <tr style="height: 19.5pt;" height="26"> <td style="height: 19.5pt;" height="26">Naveen</td> <td>Vinod</td> <td class="xl24" x:num="32997" align="right">5/4/1990</td> <td>BCom</td> <td x:str="'19-08-09">19-08-09</td> <td>Mumbai</td> </tr> <tr style="height: 19.5pt;" height="26"> <td style="height: 19.5pt;" height="26">Shree</td> <td>Ramesh</td> <td class="xl24" x:num="30819" align="right">5/17/1984</td> <td>MBA</td> <td x:str="'21-05-07">21-05-07</td> <td>Mumbai</td> </tr> </tbody></table></td> <td style="width: 81pt;" width="108">
</td> <td style="width: 72pt;" width="96">
</td> <td style="width: 72pt;" width="96">
</td> <td style="width: 72pt;" width="96">
</td> <td style="width: 72pt;" width="96">
</td> </tr> <tr style="height: 19.5pt;" height="26"> <td style="height: 19.5pt;" height="26">


</td> <td>
</td> <td class="xl22" x:num="29749" align="right">
</td> <td>
</td> <td class="xl22" x:num="38994" align="right">
</td> <td>
</td> </tr> <tr style="height: 19.5pt;" height="26"> <td style="height: 19.5pt;" height="26">
</td> <td>
</td> <td class="xl22" x:num="32997" align="right">
</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 19.5pt;" height="26"> <td style="height: 19.5pt;" height="26">
</td> <td>
</td> <td class="xl22" x:num="30819" align="right">
</td> <td>
</td> <td>
</td> <td>
</td> </tr> </tbody></table>In the door sg put a single apostrophe(') in the beginning and type the doorsg so that it will not be automatically converted to date by excel. so that these are not numbers.

I am giving two macro "test" and "undo"
as the results are going to be parked in sheet2. the macro undo clears this sheet(sheet2)

when the input boxes come up if you do not want to filter according to that criteria then leave it blank and click ok EXCEPT WHEN THE DOB INPUT BOX COMES UP YOU DO NOT LEAVE IT BLANK BUT TYPE 0 (ZERO). BE CAREFUL ON THIS. if you want to consider then you can enter the date as ENTERED in the sheet e.g. 6/12/81
IN THE INPUTBOXES THE SPELLING OF INPUT SHOULD BE EXACT.

The result of the autofilter will be in sheet2

the macros are

Sub test()
Dim spoc As String, nm As String, dob As Date, qual As String
Dim r As Range
Dim doorsg As String, univ As String

Worksheets("sheet1").Activate
ActiveSheet.AutoFilterMode = False

spoc = InputBox("type spoc, if not required leave it blank and click ok")
nm = InputBox("type recname, if not required leave it blank and click ok")
MsgBox "IF YOU DO NOT WANT TO CONSIDER DOB BE CAREFUL TOENTER 0"
dob = CDate(InputBox("type DOB, if not required ENTER 0 and click ok"))
qual = InputBox("type qualification, if not required leave it blank and click ok")
doorsg = InputBox("type doorsg, if not required leave it blank and click ok")
univ = InputBox("type univ, if not required leave it blank and click ok")
Set r = ActiveSheet.UsedRange
If spoc <> "" Then
r.AutoFilter Field:=1, Criteria1:=spoc
End If
If nm <> "" Then
r.AutoFilter Field:=2, Criteria1:=nm
End If
If CDate(dob) <> 0 Then
r.AutoFilter Field:=3, Criteria1:=dob
End If
If qual <> "" Then
r.AutoFilter Field:=4, Criteria1:=qual
End If
If doorsg <> "" Then
r.AutoFilter Field:=5, Criteria1:=doorsg
End If
If univ <> "" Then
r.AutoFilter Field:=8, Criteria1:=univ
End If
r.Cells.SpecialCells(xlCellTypeVisible).Copy
With Worksheets("sheet2")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
ActiveSheet.AutoFilterMode = False
Application.CutCopyMode = False
End Sub

Sub undo()
Worksheets("sheet2").Cells.Clear
End Sub