Find 3 Matching Criteria

NEW! More Books..

Add Excel Answers & Search To Your Google Toolbar Details

Excel: Find Feature to Find 3 Matching Criteria in 3 Columns in Excel

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only ~~$145.00~~. $59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

Got any Excel Questions? Free Excel Help .

Lot's More: Excel VBA See Also: Advanced Excel Find add-in

Advanced Excel Find Download Working Example

The standard Excel Find feature is great for locating matching cells. However, it cannot be use 'as is' to locate, say 3, matching cells on the same row within a table. What we will do, to make it different to the normal find, is allow the user to specify more than one item to locate. For example, if you have a large table of data (say A1:H1000), you may wish to find a specific row in that table where 3, or more items (if modified), occur on the one row. The number of items can be greater or smaller than 3, but for this example we will use 3.

To create this custom find you will need.

A) 1 UserForm.

B) 3 ComboBoxes. Named ComboBox1, ComboBox2 and ComboBox3. Place these vertically on the left side of UserForm with ComboBox1 at the top and ComboBox3 and the bottom. Set the Enabled Property of ComboBox2 and ComboBox3 to False.

C) 5 Labels. Named Label1 (positioned above Combobox1), Label2 (positioned above Combobox2), Label3 (positioned above Combobox3), Label4 positioned above Label1 and Label 4 anywhere for now. Change the Caption Property of Label4 to read "Select up to 3 fields". Change the Caption Property of Label5 to read "Matching Rows. Double click to go there".

D) 2 CommandButtons. CommandButton1 and CommandButton2. Change the Caption Property of CommandButton1 to "Find" and the Caption Property of CommandButton2 to "Close". Postion both of these to the top right of the UserForm.

E) 1 ListBox. Named ListBox1. Postion this below the 2 CommandButtons and place label5 above it. Make ListBox1 the same width as Label5.

That is all we need for creating the form now it's time to add the all important code. Double click the UserForm and add all the code shown below;

Option Explicit

'Module Level Variables
Dim rRange As Range
Dim strFind1 As String
Dim strFind2 As String
Dim strFind3 As String


Private Sub ComboBox1_Change()
'Pass chosen value to String variable strFind1
strFind1 = ComboBox1
'Enable ComboBox2 only if value is chosen
ComboBox2.Enabled = Not strFind1 = vbNullString
End Sub


Private Sub ComboBox2_Change()
'Pass chosen value to String variable strFind1
strFind2 = ComboBox2
'Enable ComboBox3 only if value is chosen
ComboBox3.Enabled = Not strFind2 = vbNullString
End Sub


Private Sub ComboBox3_Change()
'Pass chosen value to String variable strFind1
strFind3 = ComboBox3
End Sub

Private Sub CommandButton1_Click()
'Procedure level variables
Dim lCount As Long
Dim lOccur As Long
Dim rCell As Range
Dim rCell2 As Range
Dim rCell3 As Range
Dim bFound As Boolean

'At least one value, from ComboBox1 must be chosen
If strFind1 & strFind2 & strFind3 = vbNullString Then
        MsgBox "No items to find chosen", vbCritical
            Exit Sub 'Go no further
ElseIf strFind1 = vbNullString Then
        MsgBox "A value from " & Label1.Caption _
            & " must be chosen", vbCritical
        Exit Sub 'Go no further
     End If

'Clear any old entries
On Error Resume Next
ListBox1.Clear
On Error GoTo 0

'If String variable are empty pass the wildcard character
If strFind2 = vbNullString Then strFind2 = "*"
If strFind3 = vbNullString Then strFind3 = "*"

'Set range variable to first cell in table.
Set rCell = rRange.Cells(1, 1)
'Pass the number of times strFind1 occurs
lOccur = WorksheetFunction.CountIf(rRange.Columns(1), strFind1)

'Loop only as many times as strFind1 occurs
For lCount = 1 To lOccur
'Set the range variable to the found cell. This is then also _
         used to Start the next Find from (After:=rCell)
Set rCell = rRange.Columns(1).Find(What:=strFind1, After:=rCell, _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False)
'Check each find to see if strFind2 and strFind3 occur _
         on the same row.
If rCell(1, 2) Like strFind2 And rCell(1, 3) Like strFind3 Then
            bFound = True 'Used to not show message box for no value found.
'Add the address of the found cell and the cell on the _
             same row but 2 columns to the right.
ListBox1.AddItem rCell.Address & ":" & rCell(1, 3).Address
         End If
    Next lCount

If bFound = False Then 'No match
MsgBox "Sorry, no matches", vbOKOnly
End If
End Sub

Private Sub CommandButton2_Click()
'Close UserForm
Unload Me
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Check for range addresses
If ListBox1.ListCount = 0 Then Exit Sub
'GoTo doubled clicked address
Application.Goto Range(ListBox1.Text), True
End Sub

Private Sub UserForm_Initialize()
'Procedure level module
Dim lRows As Long

'Set Module level range variable to CurrentRegion _
of the Selection
Set rRange = Selection.CurrentRegion
    If rRange.Rows.Count < 2 Then ' Only 1 row
        MsgBox "Please select any cell in your table first", vbCritical
        Unload Me 'Close Userform
        Exit Sub
    Else

        With rRange
'Set Label Captions to the Table headings
Label1.Caption = .Cells(1, 1)
             Label2.Caption = .Cells(1, 2)
             Label3.Caption = .Cells(1, 3)

'Set RowSource of ComboBoxes to the appropriate columns _
             inside the table
ComboBox1.RowSource = .Columns(1).Offset(1, 0).Address
             ComboBox2.RowSource = .Columns(2).Offset(1, 0).Address
             ComboBox3.RowSource = .Columns(3).Offset(1, 0).Address
        End With
    End If
End Sub

Private Sub UserForm_Terminate()
'Destroy Module level variables
Set rRange = Nothing
strFind1 = vbNullString
strFind2 = vbNullString
strFind3 = vbNullString
End Sub

Now go to Insert>Module and add this code

Sub ShowForm()
On Error Resume Next
UserForm1.Show
On Error GoTo 0
End Sub

Download Working Example

Excel Dashboard Reports & Excel Dashboard Charts 50% Off

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to special@ozgrid.com 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft