Moving

I'm moving this blog to http://techperdiem.blogspot.com for ease of management. See you there.

Function that returns value in VBA

To code a function that returns value to the calling sub, use FunctionName as the VariableName in the function.

e.g.
function findrownbr()
findrownbr=10
end function

sub readCellData ()
cell_nbr = findrownbr()
msgbox Range("A" &cell_nbr)
end sub

Newline Character in VBA

Chr(13) inserts a new line character in vb.

Output
there is
newline between this and the line above.

Code
"there is a" & Chr(13) & "newline between this and the line above."

Note
Chr(13) should not be in quotes.

Reduce Font in excel with a shortcut key

In MS Word one can use
ctrl + [ to reduce font size
ctrl + ] to increase font size

These do not work in MS Excel.

Following macro reduces any given font size by 2 units. Assign it to a shortcut key e.g. ctrl + p and you're set.

Sub reduceFont()
With Selection.Font
.Size = .Size - 2
End With
End Sub

Filter rows based on Color

Sometimes we work with excel sheets that have color coded rows and we often want to look at only a particular color at a time.

Following vba code does just that. Select any one cell of the color that you want to see. And run the macro filter_on_color. Make sure that column EZ is blank.


Sub filter_on_color()
' Select any color based on which to filter the sheet
' make sure EZ is empty

colindex = Selection.Cells.Interior.ColorIndex
col = ColumnLetter(Selection.Column)
lastrowcnt = Cells(Cells.Rows.Count, "A").End(xlUp).Row

MsgBox "Filtering on cell " & (col & Selection.Row)

For i = 1 To lastrowcnt
If Range(col & i).Cells.Interior.ColorIndex = colindex Then
Range("EZ" & i) = "Filter on color"
Else
Range("EZ" & i) = ""
End If
Next i

ActiveSheet.Select
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=156, Criteria1:="Filter on color"
Range("A1").Select

End Sub

---------------------------------------------------------------------------------------

Function ColumnLetter(ColumnNumber As Integer) As String
' This function is taken from http://www.freevbcode.com/ShowCode.asp?ID=4303

If ColumnNumber > 26 Then

' 1st character: Subtract 1 to map the characters to 0-25,
' but you don't have to remap back to 1-26
' after the 'Int' operation since columns
' 1-26 have no prefix letter

' 2nd character: Subtract 1 to map the characters to 0-25,
' but then must remap back to 1-26 after
' the 'Mod' operation by adding 1 back in
' (included in the '65')

ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
' Columns A-Z
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function

Index Sheet in Workbook

This vba code creates a new first sheet called index. Index sheet contains serial number and names with hyperlinks of the worksheets in the workbook.

Sub create_index()

' Creates a new sheet called index and makes it the first sheet.
' This macro counts the number of sheet and creates a hyperlink to the sheet and places in index sheet

flg = 1

For Each varsheet In Worksheets
If varsheet.Name = "Index" Then
flg = 0
Exit For
End If
Next varsheet

If flg = 0 Then
MsgBox "Index Exists"
Else
MsgBox "Adding Index"
Worksheets.Add.Name = "Index"
'updated on 05/12
'Worksheets.Move before:=Worksheets(1)
Worksheets("Index").Move before:=Worksheets(1)
sheetcnt = ActiveWorkbook.Sheets.Count

For i = 2 To sheetcnt
Sheets("Index").Select
j = i + 3
Range("E" & j) = i - 1
Range("F" & j) = Sheets(i).Name
Range("F" & j).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & _
Range("F" & j).Value & "'!A1"
Next i
End If

End Sub

Using Excel Functions in VBA - vlookup

Say we have a Sheet1 with following data :

COL A	COL B
bat	ball
cat	mouse
zebra	crossing

To look up content of COL B for a particular value of COL A, V for vertical Vlookup function can be used.

Sub func_vlookup()

Workbooks("workbookname.xls").Activate
Worksheets("Sheet1").Activate

findthis = "cat"
in_range = Range("A1:B3")
rtn_from_col# = 2 ' indicates from which column value is being returned

MsgBox WorksheetFunction.vlookup(findthis, in_range, rtn_from_col#)
'pops up "mouse"

End Sub

Match function can be written similarly. Try it!