I'm using the code below that I found on the internet to filter data with a userform and list box. I thought everything was working OK but have discovered a slight problem that I'm unable to resolve.
If for example A,AB,ABC,B,BB.BBC appears in the drop downlist and I select A, then not only do records A appear, but AB and ABC as well. Can anyone advise how to select an exact match only?
Thanks in advance.
Dim strOperator1 As String, strOperator2 As String
Dim strOperator3 As String, strOperator4 As String
Dim rCell As Range
With Sheet2
On Error Resume Next
'Clear extract range and Criteria range
.Range("CriteriaData").ClearContents
.Range("Z1:AD100").Clear
'Put in criteria as chosen
If Dand.Value = True Then
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("C4") = "=" & """" & D2.Value & """"
Else 'It's or
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("B5") = "=" & """" & D2.Value & """"
End If
If Qand.Value = True Then
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("E4") = Q2C & Q2.Value
Else 'It's or
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("D5") = Q2C & Q2.Value
End If
'Check if any criteria has been added
If WorksheetFunction.CountA(Range("FisrtRowCriteria")) > 0 Then
'Fill in needed blank cells
For Each rCell In Range("SecondRowCriteria")
If IsEmpty(rCell) And rCell.Offset(-1, 0) <> "" Then
rCell = rCell.Offset(-1, 0)
End If
Next rCell
'Set the filter criteria range according to entries
If WorksheetFunction.CountA(Range("SecondRowCriteria")) > 0 Then
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L5").End(xlToLeft)).Name = "FilterCriteria"
Else
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L4").End(xlToLeft)).Name = "FilterCriteria"
End If
'AdvancedFilter data by chosen criteria
Range("Data_Table_With_Heads").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("FilterCriteria"), CopyToRange:=.Range("Z1")
'Name the newly created filtered table
.Range("Z1").CurrentRegion.Offset(1, 0).Name = "Filtered_Data"
ListBox2.RowSource = ""
ListBox2.RowSource = "Filtered_Data"
End If
End With
On Error GoTo 0
If for example A,AB,ABC,B,BB.BBC appears in the drop downlist and I select A, then not only do records A appear, but AB and ABC as well. Can anyone advise how to select an exact match only?
Thanks in advance.
Dim strOperator1 As String, strOperator2 As String
Dim strOperator3 As String, strOperator4 As String
Dim rCell As Range
With Sheet2
On Error Resume Next
'Clear extract range and Criteria range
.Range("CriteriaData").ClearContents
.Range("Z1:AD100").Clear
'Put in criteria as chosen
If Dand.Value = True Then
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("C4") = "=" & """" & D2.Value & """"
Else 'It's or
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("B5") = "=" & """" & D2.Value & """"
End If
If Qand.Value = True Then
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("E4") = Q2C & Q2.Value
Else 'It's or
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("D5") = Q2C & Q2.Value
End If
'Check if any criteria has been added
If WorksheetFunction.CountA(Range("FisrtRowCriteria")) > 0 Then
'Fill in needed blank cells
For Each rCell In Range("SecondRowCriteria")
If IsEmpty(rCell) And rCell.Offset(-1, 0) <> "" Then
rCell = rCell.Offset(-1, 0)
End If
Next rCell
'Set the filter criteria range according to entries
If WorksheetFunction.CountA(Range("SecondRowCriteria")) > 0 Then
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L5").End(xlToLeft)).Name = "FilterCriteria"
Else
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L4").End(xlToLeft)).Name = "FilterCriteria"
End If
'AdvancedFilter data by chosen criteria
Range("Data_Table_With_Heads").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("FilterCriteria"), CopyToRange:=.Range("Z1")
'Name the newly created filtered table
.Range("Z1").CurrentRegion.Offset(1, 0).Name = "Filtered_Data"
ListBox2.RowSource = ""
ListBox2.RowSource = "Filtered_Data"
End If
End With
On Error GoTo 0
