Excel Macro

Below is a macro i have written for excel which goes through multiple sheets one after another and searches for keywords in a specified column and then generate a master sheet with those rows.

Sub CopySearchedResult()

'Authored by Jishnu A under GPL!! :)

Dim sh1 As Worksheet
Dim sh As Worksheet
Dim rng As Range, rng2 As Range
Dim dest As Range, cell As Range
Dim SearchColNum As Integer
Dim SearchString1 As String
Dim SearchString2 As String
Dim OutputFile As String

OutputFile = "Master"

'Before creating master sheet checks if it exist and delete any older version
If SheetExists(OutputFile) = True Then
Sheets(OutputFile).Select
ActiveWindow.SelectedSheets.Delete
Application.StatusBar = "The " & OutputFile & "already exists and is Deleted"
End If

Set sh1 = Worksheets.Add
sh1.Name = OutputFile
Application.StatusBar = "New" & OutputFile & "is Created"

' This is the variable where one needs to mention the column number for search
' For example Column B should have SearchColNum = 2

SearchColNum = 6

'This are the search strings which has to be looked for in the above column number
' These search strings are "Or" ed in the macro below
' Which can be changed as "And" or other expressions

SearchString1 = "keyword1"
SearchString2 = "keyword2"

' Mention the worksheets which needs to be searched with names "Sheet1", "Sheet2" etc
' and the last digit should be mentioned as the last value of i in the expression below

For i = 1 To 8
Set sh = Worksheets("Sheet" & i)
Set rng = sh.Range(sh.Cells(2, SearchColNum), sh.Cells(Rows.Count, SearchColNum).End(xlUp))
Set rng2 = Nothing
For Each cell In rng
If InStr(cell.Value, SearchString1) > 0 Or InStr(cell.Value, SearchString2) > 0 Then
If rng2 Is Nothing Then
Set rng2 = cell
Else
Set rng2 = Union(rng2, cell)
End If
End If
Next
If Not rng2 Is Nothing Then
Set dest = sh1.Range("A" & sh1.Cells(Rows.Count, SearchColNum).End(xlUp).Row + 1)
rng2.EntireRow.Copy dest
End If
Next
Application.StatusBar = "Finished with the process.."

End Sub

' It checks if a particular sheet exist

Function SheetExists(SName As String, Optional ByVal WB As Workbook) As Boolean

On Error Resume Next

If WB Is Nothing Then Set WB = ThisWorkbook

SheetExists = CBool(Len(Sheets(SName).Name))

End Function