On Filter Multiple Condition

It would be appreciated, if any body could help me to solve my issue to filter multiple condition .

Details as follows ---

I have an excel sheet having following fields –

• Request Number
• Recieved Date
• Request Type (It can have OS,OM,OC,VC,UNKN)
• Status

The requirement is that user can select from date and End date and various type of request from the form. This should generate the report as type of the requests recived during the dates specified by user.

I have created the form and lso built a list box with in the form to select various type of request type from list box- Since user can select either one type or multiple type of request at once. I have achieved this changing property of list box from SelectSingle to SelectMulti.

But issue is that I am not able to filter the file as per the selection.

Let say , User has selected From Date as 01-Jan-07 and End Date as 30-Jan-07- And selected request types are OM,OC,VC at the same time. So report should produce all requests received with in the date has the type OM,OC,VC .

I have achived the result by reading each every record in the xl and hiding them which are not satisfying the criteria. But I do not think this is the right way to do . pLEASE HELP ME to get it done properly. See the below coding

Private Sub CommandButton2_Click()
'--------------------------------------------------------------
'This 'Generate' Button from Reportform1 for Resource Load
'--------------------------------------------------------------

Dim iCnt As Integer
Dim Selections As String
Dim UniqueValueSheet As Worksheet
Dim UniqueValueSheetNm As String
Dim SelectedOptions As String

Dim Blank As String
Dim ReportFromDt As String
Dim ReportEndDt As String
Blank = ""
UniqueValueSheetNm = "UniqueValueSheet"
Set UniqueValueSheet = Worksheets(UniqueValueSheetNm)

For iCnt = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(iCnt) = True Then
Selections = Selections & ListBox1.List(iCnt) & ","
End If
Next iCnt
If Trim(Selections) = Blank Then
Res = MsgBox("Please Select Request Type!! ", vbOKOnly)
Exit Sub
End If
SelectedOptions = Left(Selections, Len(Selections) - 1)
Coma = InStr(SelectedOptions, ",")
StringAll = InStr(SelectedOptions, "All")
If Coma > 0 And StringAll > 0 Then
Res = MsgBox("You can not use 'All' with other combination" & Chr(13) & " " _
& " " & " Please correct", vbOKOnly)
Exit Sub
End If


If Trim(ReportStatus1.TextBox1.Value) = "" Or Trim(ReportStatus1.TextBox2.Value) = "" Then
Res = MsgBox("From Date or End Date is Missing !!! Please Correct !!!!", vbOKOnly)
Exit Sub
Else
ReportFromDt = ReportStatus1.TextBox1.Value
ReportEndDt = ReportStatus1.TextBox2.Value
End If
Call FilterRows(SelectedOptions, ReportFromDt, ReportEndDt)
Unload Me
End Sub
Sub FilterRows(Selections As String, ReportFromDt As String, ReportEndDt As String)

'----------------------------------------------------------------------------------
'This section is filter the record as per the criteria from the ReportForm1 screen
'Write into a temp file
'----------------------------------------------------------------------------------

Dim Sel() As String

Dim lLastrow As Long
Dim lRow As Long
Dim WRMasterXls As Workbook

Dim WRMasterSheet As Worksheet
Dim UniqueValueSheet As Worksheet
Dim ConfigSheet As Worksheet
WRMasterXlsNm = ActiveWorkbook.Name
Set WRMasterXls = Workbooks(WRMasterXlsNm)
ConfigSheetNm = "Configuration-Table"
Set ConfigSheet = WRMasterXls.Worksheets(ConfigSheetNm)

Dim UniqueValueSheetNm As String
Dim WRMasterSheetNm As String

UniqueValueSheetNm = "UniqueValueSheet"
Set UniqueValueSheet = WRMasterXls.Worksheets(UniqueValueSheetNm)
WRMasterSheetNm = ConfigSheet.Cells(6, 3) '"Request-Tracker-Sheet"

If Trim(WRMasterSheetNm) = "" Then
WRMasterSheetNm = "Request-Tracker"
ConfigSheet.Cells(6, 3) = WRMasterSheetNm
End If
Set WRMasterSheet = WRMasterXls.Worksheets(WRMasterSheetNm)


Dim ComaCnt As Integer
Dim ComaPos As Integer
Dim iCount As Integer
Dim ArrayOccur As Integer
ComaCnt = 0
ComaPos = 0

' Finding out number of coma's in the multiple selection to define the array

For iCount = 1 To Len(Selections)
ComaPos = InStr(ComaPos + 1, Selections, ",")
If ComaPos > 0 Then
ComaCnt = ComaCnt + 1
Else
iCount = Len(Selections)
End If
Next iCount

' Resizing the Array

ReDim Sel(1 To ComaCnt + 1)

' Segregating the multiple selection into seperate array variable

iCount = 0
ComaPos = 0
Do Until iCount >= Len(Selections)
ComaPos = InStr(ComaPos + 1, Selections, ",")
If ComaPos > 0 Then
ArrayOccur = ArrayOccur + 1
iLength = iCount - (ComaPos - 1)
Sel(ArrayOccur) = Mid(Selections, iCount + 1, Abs(iLength))
iCount = ComaPos
End If
If ComaPos = 0 Then
ArrayOccur = ArrayOccur + 1
Sel(ArrayOccur) = Mid(Selections, iCount + 1)
iCount = Len(Selections)
End If
Loop

' Hiding the rows which are not satisfying the criteria

lRow = 2
Application.ScreenUpdating = False
lLastrow = Lastraw(WRMasterSheet)
rCnt = 0
If Selections <> "All" Then
For lRow = 3 To lLastrow Step 1
iRequestTypeFound = "N"
For rCnt = 1 To (ComaCnt + 1) Step 1

iRequestType = WRMasterSheet.Cells(lRow, 8)
If iRequestType = Sel(rCnt) Then
iRequestTypeFound = "Y"
End If

Next rCnt
If iRequestTypeFound = "Y" Then
WRMasterSheet.Rows(lRow).EntireRow.Hidden = False
Else
WRMasterSheet.Rows(lRow).EntireRow.Hidden = True
End If
Next lRow
End If

Application.ScreenUpdating = True
UniqueValueSheet.UsedRange.Clear
ctr = 0

destinationRow = 1

For Each r In WRMasterSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows
ctr = ctr + 1

WRMasterSheet.Rows(r.Row).Copy UniqueValueSheet.Rows(ctr)
destinationRow = destinationRow + 1
Application.CutCopyMode = False
Next
WRMasterSheet.UsedRange.EntireRow.Hidden = False

'------------------------------------------------------------------------------
'Copying back records from Temporary sheet to Master Sheet
'------------------------------------------------------------------------------
a = WRMasterSheet.Name
TmpSheet = "TmpSheet"
WRMasterSheet.Name = TmpSheet
UniqueValueSheet.Name = a

StatusCheck
Application.DisplayAlerts = False
UniqueValueSheet.Delete

Application.DisplayAlerts = True
WRMasterSheet.Name = a

If Not WRMasterSheet.AutoFilterMode Then
If Not WRMasterSheet.FilterMode Then
WRMasterSheet.Range("A2").AutoFilter
End If
End If



End Sub

jophy