Thursday, January 08, 2009

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

Thursday, January 01, 2009

Cool add-ons from Windows

This site provides some cool add-ons to firefox. There is a ClearType Tuner which allows all applications to be moved to a font which you can feel and apply to all the applications including firefox. Using this you can have firefox font look same as IE7 or whatever browser font you like. This will give a uniform view of fonts across all applications. Another is a ALT+TAB replacement which again is better in case you belong to the category of people like me who keeps lots of application opened. I have not tried others, but will comment on it once i have installed those.