Boolean Search Function for Excel

[DieselD]

Hi everyone,
I've been searching for the past few days for a boolean search function for MS Excel.

Currently I have a database of information organized into rows with extra infomation in additional columns. So for example, I have NAME in column A, DATE, in column B, REPORT_TITLE in column C, etc. The search script I have written uses Excel's FIND and FINDNEXT code and works well for single words or phrases (although a bit slow), and during the search, the whole row is copied to an additional sheet. However, my problem is that I would like to search using AND / OR / NOT descriptors.

Has anyone come across any boolean search scripts for Excel?



Thanks in advance.

 

[SkipVought]

Hi,

Please post the code that you are currently using.

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[DieselD]

I'm a bit shy, so please don't laugh at the code I wrote!

Sub Button1_Click()
    
    Dim SearchString As String
    Dim FirstHit As Integer
    
    Dim NextHit As Integer
    Dim NextRow As Integer
    Dim MaximumPossibleHits As Integer
    
    On Error GoTo ResolveError
    
    '    MsgBox ("Here is the searchstring '" + SearchString + "'")
    
    Application.ScreenUpdating = False  ' Turn off ScreenUpdating (for faster marco running!)
    SearchString = Sheet1.TextBox1.Text    ' Set up search
    
    
    
    Range("A2").Select
    'MsgBox ("Here is the searchstring '" + SearchString + "'")
    
    
    Workbooks.Open Filename:="T:\Database.xls"
    
    ' Find the maximum number of inputed data
    Range("B2").Select
    Selection.End(xlDown).Select
    MaximumPossibleHits = ActiveCell.Row - 1
    
    Range("Z1").Select   'If not Z1, then will miss column A, row 2
    
    Cells.Find(What:=SearchString, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    FirstHit = (ActiveCell.Row)
    
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Copy
    
  
    Windows("Search Database.xls").Activate
    Selection.Insert Shift:=xlDown

    Rows("2:2").Select
    
 '  Put a line in to separate previous search
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    Range("A2").Select

    ' Repeat the next part for as many times as there is data
    x = 0
    TotalHits = 0
        
    Do While ((x < MaximumPossibleHits) = True)
        Windows("Database.xls").Activate
        
        ActiveCell.Offset(0, 15).Select     ' prevents finding same item on same row
        
        Cells.FindNext(After:=ActiveCell).Activate
        
        NextHit = ActiveCell.Row
        
        ActiveCell.Rows("1:1").EntireRow.Select
        Selection.Copy
        
        x = x + 1
        If (FirstHit >= NextHit) Then x = MaximumPossibleHits + 1   ' prevents 'finding' the header in the search
        TotalHits = TotalHits + 1
        
        
        Windows("Search Database.xls").Activate
        Selection.Insert Shift:=xlDown
        Range("A2").Select
  

        
    Loop
    
    Windows("Search Database.xls").Activate
    Range("A2").Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    
    
    
    
    ActiveSheet.Range(Cells(2, 1), Cells(TotalHits + 1, 1)).EntireRow.Select
    Selection.Sort Key1:=Range("F2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    ' Copy header from Database
    Range("A2").Select
    Windows("Database.xls").Activate
    
    Range("A1").Select  ' copy the header information from database file
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Copy
    Windows("Search Database.xls").Activate
    Selection.Insert Shift:=xlDown
    
    '  Display number of hits and search term
    Range("A2").Select
    ActiveCell.Rows("1:1").EntireRow.Select
    
    Selection.Insert Shift:=xlDown
    Range("A2").Value = "Searched for: '" + SearchString + "'.  Out of " + CStr(MaximumPossibleHits) + " entries, there were " + CStr(TotalHits) + " total hits."
    Range("A2").Rows("1:1").EntireRow.AutoFit
    Range("A2").Font.ColorIndex = 10 
End Sub