Solved

VBScript:  Search through an Excel Workbook for Multiple Keywords

Posted on 2012-12-21
2
984 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
Attackers love to prey on accounts that have privileges. Reducing privileged accounts and protecting privileged accounts therefore is paramount. Users, groups, and service accounts need to be protected to help protect the entire Active Directory …

710 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