Excel Search Tool (Macro)

• Download script - 922 B

Introduction

This macro script is used to search for specific cells in Excel documents and copy the cells into a separate sheet.

Background

This is my first project on CodeProject, and my first VBA script, so I am open to suggestions on how to improve my code! I wrote this script along with the help of my co-workers to search through our documents quickly and retrieve data.

Using the Code

The code is meant to be imported into an Excel document. The file is linked with the .bas extension.

Error Catch

On Error GoTo ErrorCatch

Variables

Dim WorkSheet_Count As Integer
Dim index As Integer
Dim columnCount As Integer
Dim inputRange As Range
Dim cellContent As String

Initial Headers to Define Columns

'Add all column names.
Sheets("SearchResults").Range("A1:E1").Value = _
    Array("Customer Name", "Example Column", 
    "Example Column", "Example Column", "Example Column")

Main Body

'Suggested by Dennis (<a href="https://www.codeproject.com/script/Membership/View.aspx?mid=169517">
DW1962</a>) to prevent flickering of the screen while processing data
Application.ScreenUpdating = False

' Set WS_Count equal to the number of worksheets in the active workbook.
WorkSheet_Count = ActiveWorkbook.Worksheets.Count

' Begin the loop.
         For index = 2 To WorkSheet_Count
           
            'Search for the string "Customer Name"
            Set inputRange = ActiveWorkbook.Worksheets(index).Cells.Find("Customer Name:")
            
               'If it is found, continue
               If Not inputRange Is Nothing Then
                   cellContent = ActiveSheet.Cells(inputRange.Row, _
                   (inputRange.Column + 1)).Address(False, False)
                   Sheets(ActiveWorkbook.Worksheets(index).Name).Range(cellContent).Copy Worksheets_
                   ("SearchResults").Range("A" & index)
            
               'If it is empty, set the cell value to "No Information"
               Else
                   Sheets("SearchResults").Range_
                   ("A" & index).Value = "No Information"
            
               End If
               Set inputRange = Nothing

         'Move to the next sheet to search       
          Next index


    'Suggested by Dennis (<a href="https://www.codeproject.com/script/Membership/View.aspx?mid=169517">
                           DW1962</a>) to "fix the columns' width"           
    '------Loop through and Auto Fit all columns-----'
    For columnCount = 1 To ActiveSheet.UsedRange.Columns.Count
 
    Columns(columnCount).EntireColumn.AutoFit
 
    Next columnCount

    Exit Sub

'Here is the catch for errors
ErrorCatch:
    MsgBox "There was an error while searching for the cell"

End Sub

To find the cell, you need to replace the string in inputRange to whatever you want to search for:

Set inputRange = ActiveWorkbook.Worksheets(index).Cells.Find_
("Whatever you want to search for here")

Also, you need to choose whatever you want your sheet that collects the search information to be:

Sheets(ActiveWorkbook.Worksheets(index).Name).Range(cellContent).Copy Worksheets_
("Whatever sheet name you want").Range("A" & index)

Points of Interest

I learned much about how to program macros from making this project, and I hope it will help some of you as well!

Also, I got the worksheet looper from this Microsoft article.

How to Import the Macro

1. Open Excel and then click Developer > Visual Basic.
2. To import the macro, click File > Import File, go to the folder where you exported your macro, select the file, and then click Open.
3. Save the module.
4. Create a new sheet named "SearchResults" (whatever sheet name you specified in this line):

   Sheets(ActiveWorkbook.Worksheets(index).Name).Range(cellContent).Copy Worksheets("Whatever sheet name you want").Range("A" & index)

5. Run the macro and gather results.

History

• V1.0 Released 12/13/2016
• V1.1 Released 12/15/2016
  • Changed code, implementing suggestions
  • Updated script in zip file