Solved

VBScript:  Search through an Excel Workbook for Multiple Keywords

Posted on 2012-12-21
2
960 Views
Last Modified: 2012-12-28
Hello Experts!

      I have yet to come across anything in my research that assist me in finding multiple keywords in Excel when performing a search through a spreadsheet that can consist of over 100,000 rows with 18 columns.

     A Macro would do this, but a macro can be time consuming when setting up each search.   I need something like a VBScript or .HTA that has a GUI that will allow me to browse out to the .xls or .xlsx file Open it, add my list of keywords that I want to search on.  Once my keywords have been entered, I could just click "Start" it would scrub through the entire worksheet looking for these keywords and highlight them as it finds them.  It might even provide a location in the spreadsheet for each find, just as the native search function does in Excel. I could then open that workbook and see the highlighted keywords.  

    An help is greatly appreciated!
0
Comment
Question by:itsmevic
2 Comments
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 38714125
This should be enough to get you started.  It's VBA for Excel, but can be adapted to VBScript if you like.

The attached file has a working example.  It highlights and filters the original sheet, and creates a new file with just the matches.

Sub FindThem()
    
    Dim SourceRng As Range
    Dim FindRng As Range
    Dim FirstRow As Long
    Dim Words As Variant
    Dim WordCounter As Long
    Dim SourceWb As Workbook
    Dim SourceWs As Worksheet
    Dim DestWb As Workbook
    Dim DestWs As Worksheet
    Dim LastCol As Long
    Dim DestRow As Long
    
    Set SourceWb = ActiveWorkbook
    Set SourceWs = SourceWb.Worksheets(1)
    
    Set DestWb = Workbooks.Add
    Set DestWs = DestWb.Worksheets(1)
    DestRow = 1
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    With SourceWs
        .[a1].AutoFilter
        .Cells.Interior.ColorIndex = xlColorIndexNone
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .[a1].Resize(1, LastCol).Copy DestWs.Range("b1")
    End With
    
    DestWs.[a1] = "Row #"
    
    Words = Array("peoria", "utica", "troy")
    
    For WordCounter = LBound(Words) To UBound(Words)
        Set SourceRng = SourceWs.[c:c]
        Set FindRng = SourceWs.[c1]
        FirstRow = 0
        
        Do
            With SourceRng
                Set FindRng = .Find(Words(WordCounter), FindRng, xlValues, xlPart, , xlNext, False)
                If Not FindRng Is Nothing Then
                    If FindRng.Row = FirstRow Then Exit Do
                    If FirstRow = 0 Then FirstRow = FindRng.Row
                    DestRow = DestRow + 1
                    SourceWs.Cells(FindRng.Row, 1).Resize(1, LastCol).Copy DestWs.Cells(DestRow, 2)
                    DestWs.Cells(DestRow, 1) = FindRng.Row
                    SourceWs.Rows(FindRng.Row).Interior.Color = vbYellow
                Else
                    Exit Do
                End If
            End With
        Loop
    Next
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    If DestRow > 1 Then
        SourceWs.[a1].AutoFilter Field:=3, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        MsgBox "Done"
    Else
        DestWb.Close False
        MsgBox "No matches found"
    End If
        
End Sub

Open in new window


Q-27975402.xlsm
0
 

Author Closing Comment

by:itsmevic
ID: 38728083
Thank you.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Script to copy or move mouse-selected collection of files plus targets referenced by shortcuts (.lnk) The purpose of this article is to help illuminate the real challenges and options available (where they may exist) for utilizing simple scriptin…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

713 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question