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 |