Consulting

Results 1 to 3 of 3

Thread: Search rows on one or more criteria

  1. #1

    Search rows on one or more criteria

    Hi everyone,

    My boss wanted an improvement to a spreadsheet I made. I had the ability of the user to search each column for a value and hide the rest of the rows that didn't contain the information (even part of the value). It was working but I made a separate search for 4 different columns. He wants to see if the user can search on muntiple column criteria and display the rows that contain the information.

    Here's what I have so far:
    Sub searchProject()
    Dim rRng As Range
    Dim check As Boolean
    Dim row As Range
    Dim cell As Range
    Dim ColumnRange As String
    Dim searchRange As String
    Dim rowText As String
    Dim projectNumberSearch As String
    Dim projectNumberRange As String
    Dim projectNameSearch As String
    Dim projectNameRange As String
    Dim clientSearch As String
    Dim clientRange As String
    Dim projectManagerSearch As String
    Dim projectManagerRange As String
    Dim countnonblank As Integer
    Dim populatedRows As Integer
    Dim myRange As Range
    Dim nextRow As Integer
    Dim currentRow As Integer
    Dim i As Integer
    Set myRange = Columns("E:E")
    countnonblank = Application.WorksheetFunction.CountA(myRange)
    populatedRows = countnonblank + 5
    projectNumberSearch = ActiveSheet.Range("B4").Value
    projectNumberRange = "B7:B" & populatedRows
    projectNameSearch = ActiveSheet.Range("C4").Value
    projectNameRange = "C7:C" & populatedRows
    clientSearch = ActiveSheet.Range("D4").Value
    clientRange = "D7:D" & populatedRows
    projectManagerSearch = ActiveSheet.Range("E4").Value
    projectManagerRange = "E7:E" & populatedRows
    If projectNumberSearch = "Enter Search Text" Then
    projectNumberSearch = ""
    End If
    If projectNameSearch = "Enter Search Text" Then
    projectNameSearch = ""
    End If
    If clientSearch = "Enter Search Text" Then
    clientSearch = ""
    End If
    If projectManagerSearch = "Enter Search Text" Then
    projectManagerSearch = ""
    End If
    ColumnRange = "B7:F" & populatedRows
    'i is the first row that information can be added to on the spreadsheet, so i = row 7
    i = 7
    Set rRng = ActiveSheet.Range(ColumnRange)
    searchRange = "B7:B" & populatedRows
    ActiveSheet.Range(searchRange).Select
        Set cell = Selection.Find(What:=projectNumberSearch, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    If cell Is Nothing Then
        MsgBox "The value cannot be found."
    Else
    For Each row In rRng.Rows
      currentRow = i
        i = i + 1
      
    rowText = ActiveSheet.Range("B" & currentRow).Value
    If InStr(ActiveSheet.Range("B" & currentRow), projectNumberSearch) Then
    Else
        ActiveSheet.Range("B" & currentRow).EntireRow.Hidden = True
    End If
    Next row
    End If
    End Sub
    I am trying to figure out how to search more than one criteria (like project number AND project manager) and have the rows that contain part of the criteria (like 2007 out of 20071245 for a project number) displayed.

    As I am not a coder at all, I found some information on the internet and have modified it for use.

    Any help and/or guidance is appreciated.

    Thank you all.
    b.
    Last edited by brent.fraser; 05-14-2014 at 10:30 AM. Reason: changed one of the variables to match previous syntax
    Survived the flood and beginning to rebuild a beautiful city.

  2. #2
    figured it out.

    Sub SearchMulti()
    Dim row As Long
    Dim searchRange As String
    Dim projectNumberSearch As String
    Dim projectNumberRange As String
    Dim projectNameSearch As String
    Dim projectNameRange As String
    Dim clientSearch As String
    Dim clientRange As String
    Dim projectManagerSearch As String
    Dim projectManagerRange As String
    Dim populatedRows As Integer
    Dim countnonblank As Integer
    Dim myRange As Range
    Set myRange = Columns("E:E")
    countnonblank = Application.WorksheetFunction.CountA(myRange)
    populatedRows = countnonblank + 5
    projectNumberSearch = ActiveSheet.Range("B4").Value
    projectNumberRange = "B7:B" & populatedRows
    projectNameSearch = ActiveSheet.Range("C4").Value
    projectNameRange = "C7:C" & populatedRows
    clientSearch = ActiveSheet.Range("D4").Value
    clientRange = "D7:D" & populatedRows
    projectManagerSearch = ActiveSheet.Range("F4").Value
    projectManagerRange = "F7:F" & populatedRows
    If projectNumberSearch = "Enter Search Text" Then
    projectNumberSearch = ""
    End If
    If projectNameSearch = "Enter Search Text" Then
    projectNameSearch = ""
    End If
    If clientSearch = "Enter Search Text" Then
    clientSearch = ""
    End If
    If projectManagerSearch = "Enter Search Text" Then
    projectManagerSearch = ""
    End If
    'MsgBox projectManagerSearch
    'MsgBox clientSearch
    searchRange = "B1:F" & populatedRows
    'MsgBox searchRange
    With ActiveSheet.Range(searchRange)
            
            MsgBox "You are Searching on:" & vbCrLf & _
               "Project Number: " & projectNumberSearch & " " & vbCrLf & _
               "Project Name: " & projectNameSearch & " " & vbCrLf & _
               "Client Name: " & clientSearch & " " & vbCrLf & _
               "Project Manager: " & projectManagerSearch & " " & vbCrLf
        For row = 7 To .Rows.Count 'Starts in 2 to ignore header!
        'MsgBox row
            'If ActiveSheet.Range("B" & row).Value Like projectNumberSearch And .Cells(row, "C").Value Like projectNameSearch And .Cells(row, "D").Value Like clientSearch Then
            'If ActiveSheet.Range("B" & row).Value Like "*" & projectNumberSearch & "*" Then
            
            If ActiveSheet.Range("B" & row).Value Like "*" & projectNumberSearch & "*" And ActiveSheet.Range("C" & row).Value Like "*" & projectNameSearch & "*" And ActiveSheet.Range("D" & row).Value Like "*" & clientSearch & "*" And ActiveSheet.Range("F" & row).Value Like "*" & projectManagerSearch & "*" Then
            'MsgBox "This is a match!"
            ActiveSheet.Range("B" & row).EntireRow.Hidden = False
            Else
            Application.ScreenUpdating = False
            ActiveSheet.Range("B" & row).EntireRow.Hidden = True
                'Debug.Print .Cells(row, valueCol)
            End If
        Next
    End With
    End Sub
    Survived the flood and beginning to rebuild a beautiful city.

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    You don't need any code if you make a table of the data: all searchcriteria can then be found and chosen in the columnlabel..

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •