vba

Moving

2009-12-03T20:04:00.000-08:00

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

Function that returns value in VBA

2009-12-01T07:00:00.000-08:00

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

2009-12-01T06:00:00.000-08:00

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

2009-07-13T06:00:00.000-07:00

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

2009-05-21T06:26:00.000-07:00

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

2009-04-23T18:18:00.000-07:00

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

2008-09-02T23:21:00.001-07:00

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!

Using Excel Functions in VBA - Sum

2008-08-28T23:44:00.001-07:00

Sub function_sum()
x = 2
y = 3
some = WorksheetFunction.Sum(x, y)
End Sub

Try to modify code to
1) Display the numbers being added and the sum.
2) Get numbers as user input and sum them up.

Find out how is concatenation done in VBA. It has already been used in previous examples.

Get Last Used Row

2008-08-27T17:19:00.001-07:00

Sub get_last_used_row()
' to get the last non-blank row

LastRow1 = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'this is the keyboard equivalent of selecting a range using shift and down arrow
' Exercise What does "A" signify??

LastRow2 = UsedRange.Rows.Count

MsgBox "LastRow1 " & LastRow1
MsgBox "LastRow2 " & LastRow2

End Sub

Exercise - What is the difference between LastRow1 and LastRow2. Though they might give same results occasionally, the approach to get the last row is different. Find it out!

selcells

2008-08-26T19:59:00.001-07:00

Sub selcells()
' this sub shows how to get a cell value
ActiveSheet.Select
cellval = Cells(1, "A")
MsgBox cellval
End Sub

Try writing a sub that copies value of A1 into B1 without use of an intermediate variable.

Select row, column

2008-08-25T19:27:00.000-07:00

There are exercises too, today using what you learnt yesterday.

#1
Sub selrow()
ActiveSheet.Select
Range("A1:E1").Select
'exercise - add code to give message when row is selected
End Sub

#2
Sub selcol()
ActiveSheet.Select
Range("A1:A10").Select
'exercise - add code to give message when row is selected
End Sub

Also, if you have time, find out how you can select an entire column. In the above example, we're selecting just a small range.

Msgbox Inputbox

2008-08-25T19:26:00.000-07:00

Open excel
Do Alt F11
Paste -

Sub pgmhello()

MsgBox "Hello"
' accept name from user
name1 = InputBox("Name Please")

' concatenate hello and user name
MsgBox "Hello" & name1

End Sub

Click green triangular button or PF5

Try it!