VBA Notes

VBA
1991-1998 VB 1.0 – 6.0
 In MS Office -2007, complete vba features

 Later VBA facility was available in non-Micro soft products
VBA: Visual Basic Application
1. VB: is a software to develop new application software

 It must be installed separately
 One must have good knowledge to work with it
 It must be purchased separately
 It is used to develop desktop, internet, intranet
2. VBA: it is used to enhance or automate manual tasks in the an existing software

 It is bundled with application software (Example: within Excel)
 No Extra license required( No need to purchase)
 VBA is an IDE (Integrated Development Environment)
 GUI Can be created using VBA
3. VB Scrip:
 It is installed by default with windows
 It has no IDE(Integrated Development Environment)
 .vbs is the file extension
 It is used for login s script and web application
- Enable Developer Tab(MS office 2007)

Office button-> Excel options -> popular -> select show developer tab
- Alt+F11 -> to go to VB editor

- This is called VBIDE
- This environment support coding , debugging, designing, compiling and running options
Bug :(An Error) : A bug may syntaxical error , (Compile error) , runtime error. (resource missing) or a logical
problem in the program (wrong variables or approach)
Note: Alt+F11 is used to switch bw excel and VBE
Alt+Q close VBE

Macros:
 Programs written or recoded to automate the tasks.

 Macros are reusable
 ALT+F5 to display the list of available macros
Recording Macros:
Click record macro button on the start bar
Rules:
i. Max 255 Characters
ii. Spaces are not allowed
iii. underscore can be used
iv. First Character must be a letter
Note: VBA is not case sensitive
Shortcut key (Optional)
Any letter
Note: * shortcut keys are case sensitive
 Shortcut keys can be overwritten
Store Macro in :
a. This work book: Current macro will be stored in the active work book
b. New work book: If this option is selected a new work book will be created (with single worksheet) and the
macro will be stored in it.
c. Personal Macro work book(pmw)
 Optionally a pmw is created for each user
 By default there is no pmw in excel
 If this option is created for the first time pmw is created for the macro will be recorded in it.
 Next time onwards the save pmw is anabled to store in unlimited no of macros
 Macros in pmw can be accessed from all work books
 PMW is a hidden workbook
 Pmw is opened automatically whenever an excel session starts
 Name of the pmw, personal .xlsb binary
Note: Binary files are optional for fast loading and space
Path of pmw(windows 7)
<<Drive>> : \ <<username>> \ appdata\roaming\microsoft\excel\XLSTART
First time personal .xlsb must be saved in excel or vbe
How to view personal .xlsb from excel
View tabs -> unhide -> personal -> ok
Note: by default there is only one work sheet in pmw
4. Description: (optional):
Place to work notes, purpose, summary etc
Note: perform some action in excel click stop recorded button on the start bar
Click “Ok”
Perform required action in excel and click stoop record button on the status bar
NOTE: By default recoded macros use absolute reference
USE RELATIVE REFERENCE
If this option is selected macros are recoded with actions relative to the initial selected cell
MACRO SECURITY
By default all macros are disabled (with notification)
VBA IDE(Visual Basic Editor)
Standard tool bar: contains frequently used menu commands as buttons
Project Explorer (Ctrl + R)
This window displays all open workbooks as VBA projects
Each VBA project has default category called Microsoft excel objects. (sheet1, sheet2, shee3,…..sheet, this
workbook)
A VBA project can have forms, modules, class modules
By default recorded macros are stored in modules
Note: generally code in a module is opn(public) for all open work books
THE BASIC STRUCTURE OF A MACRO
Sub macro_name()
code
end sub
sub: sub procedure
blue color are key words
green means comments
‘ is used to comment a line or part of line
Commented lines are non-executable
To comment/uncomment a block of lines
Use comment block/uncomment block from edit tool bar
VIEW THE CODE OF A MACRO
There are two ways
Way1:
 open VBE(Alt + F11)

 Open Project explorer(Ctrl + R)
 Select the worksheet that contain macro
 Expand module category
 Double click the recently created module
(The code is displayed inside code window)
Way2:
ALT + F8 - > select macro -> click edit
Code Window:
 Navigation login code window

 Ctrl + Up/Down - > to switch bw programs
 Others -> Ctrl + Home, Ctrl + End, Home, End
 Ctrl+Y delete current line
 Ctrl Z undo
 Ctrl+Shift+F2 last edited position
 Ctrl A select all
 Ctrl + F Find
 Ctrl H find and replace
 Shift+Tab – increase indent
i. Full module review: displays all programs in the current module

ii. Procedure view: displays only the selected or current program
Object drop down list:
This drop down list displays all available objects (default is general)
PROCEDURE DROP DOWN LIST
Displays procedure for the currently selected objects
PROPERTIES WINDOW (F4)
This window displays the properties of the selected item, alphabetically or category wise and enables the user to
modify
IMMIDIATE WINDOW(CTRL G)
 This window is used to execute any VBA statement

 The contents of this window are temporary
 Print or ? is used to display the results of a VBA statement in the immediate window
 VBA statement can be executed by pressing enter key
 Ctrl + Enter create a blank line
 Debug, print stement from a program prints to the window
Example:
?10+30
40
?activesheet.name
Sheet6
?activeprinter
WebEx Document Loader on Ne00:
?activecell.Address
$A$1
OPERATIONS IN VBS
1. ARTHEMETIC: +, -, *, /
MOD: returns reminder
Ex : 13 mod 2 -> 1
^ (power)
Ex: 3 ^ 3 result 9
\ (Integer division)
Returns values executed decimals
Ex: 13/2 result 6
2. LOGICAL
AND , OR , NOT
The above are used with IF Statement

3. Comparision: =, <, <=, >, >=, <>, LIKE
4. CONCATENATION: & or + (gives priority to sum)
DATA TYPES:
1. NUMBER
a. BYTE
(A-Z: 65-90, a-z, 97-122, 0-9, 48-57)
A data type is used to hold positive integer number ranging from 0 to 255
b. INTEGER
Numbers ranging in value from -32,768 to 32,767 (65536)
c. LONG
Numbers ranging in value from 2,147,483,648 to 2,147,483,647
d. SINGLE
Can store decimal values
e. DOUBLE (always we work with it) ----
2. STRING (one or more characters)

a. Fixed length string : MAX 2^16
This data type is shown by using *
Ex: Dim gender as string * 1
b. Variable length string max 2^ 31
3. DATE : date and time

1st Jan 100 00:00:00 to
31st Dec 9999 23:59:59
4. Boolean : true / false

5. Object : store file system objects, other applications
6. Variant: can store any type of data (this is the default data type in VBA
Note: Declaring a data type for the variable is not mandatory in VBA
WRITING THE MACRO
 ALT+F11
 INSERT – MODULE (ctrl R)
 Type SUB key word space and the name of the macro
Example :
Sub macrosample()
Sheets.Add Count:=10
End Sub
 Press F5 in VBA to run macro
RUN MACRO FROM EXCEL
 ALT + f8
 Select macro -> click run
ADDING MACRO TO QUICK ACCESS TOOL BAR
 Customize quck access toolbar or right click on tab and select customize quick access tool bar
 Select macros option from choose commands drop down list
 Select the macro and click add
Note: use move up or down option to change the order of commands
 Click ok
ASSOCIATE A MACRO WITH AN IMAGE
 Insert shape smiley face

 Right click , select assign macro and select required macro -> Ok (Click outside the image)
REMOVE ASSIGNED MACRO FROM AN IMAGE
 Right click the image , select assign macro , press deleted key and click ok
BUILT IN FUNCTIONS IN VBA
1. ABS : Return positive or absolute value

Example:
?ABS(-345.678)
345.678
?ABS(9-34)
25
?ABS(30)
30
2. ASC : Returns ASCCI value
Example :
?ASC("A")
65
?ASC("R")
82
?ASC("34")
51
?ASC("%")
37
?ASC(" ")
32
3. CHR
Exaple
? CHR(89)
Y
?CHR(120)
X
Note: test(string) must be in “ “
Note : date must be in # #
4. FIX (returns integer part (no decimal part)

?FIX(234.55566)
234
5. ROUND
Syntax: ROUND(number, [no of digits after decimal])
Note: items [] are optional
Example :
?ROUND(3455.45667)
3455
?ROUND(34566.56789,2)
34566.57
6. LEN : length of the character
Example:
?len("34567")
5
?len("")
0
?len("ac de")
5
7. LEFT : returns no of characters from left
Example:
?left(" az bc z",3)
az
?left("a23sdfd",4)
a23s
8. RIGHT: returns the required no of characters from right
Example
?right("innovation",4)
tion
?right("sadaf 89 as",4)
9 as
9. MID(string, start, length) : return the no of characters from given position
EXAMPLE:
?MID("AKE2345SDF",3,4)
E234
?MID("EA1A D32E",3,5)
1A D3
10. INSTR([start],string1,string2)
Find pos of string2 in string 1 and returns the position if found. Returns 0 if not found
EXAMPLE:
?INSTR("CORPORATE FLOOR","OR")
?INSTR(3,"CORPORATE FLOOR","OR")
?INSTR(3,"CORPORATE FLOOR","ABC")
?INSTR(3,"CORPORATE FLOOR","OR",vbTextCompare)
11. STRREVERSE: whatever you want reverser this function will reverse
EXAMPLE:
?STRREVERSE("ABC DEF")
FED CBA
?STRREVERSE("34343DSS ")
SSD34343
12. LCASE: This function will convert into lcase
?LCASE("SFSDFSDFDS")
sfsdfsdfds
?lcase("DSsd2334AS")
dssd2334as
13. UCASE: this fuction will convert the string into Ucase
Example:
?ucase("sdfsAERE sfddf")
SDFSAERE SFDDF
14. StrConv:
?Strconv("abC DefG HesEho", vbProperCase)
Abc Defg Heseho
15. REPLACE: REPLACE(string, find , replace)

?replace("jack and jue","j","bl")
black and blue
?replace(" jack and jue"," ","")
jackandjue
16. SGN: return sign of a number

?SGN(-3434)
-1
?SGN(100)
1
?SGN(0)
0
?SGN(-0)
0
?SGN(3434-23233243)
-1
17. TRIM: removes initial and last spaces

?TRIM(" ABC DEF ")
ABC DEF
18. LTRIM: removes left side spaces of the string
?LTRIM(" ABC ")
ABC
19. RTRIM: Removes right side spaces of the string
?RTRIM(" ADADF ")
ADADF
20. DATE:
?date
11/1/2012
?format(date,"dd-mmm-yyyy")
01-Nov-2012
?format(date,"dddddd")
Thursday, November 01, 2012
?format(date,"ddd")
Thu
?format(date,"dd")
01
?format(date,"d")
1
?format(date,"yyyy")
2012
?format(date,"yy")
12
?day(date)
1
?month(date)
11
?monthname(month(date))
November
?monthname(6)
June
?weekdayname(weekday(date))
Thursday
?weekdayname(3)
Tuesday
?isdate("32-feb-2012")
False
?isdate("29-feb-2012")
True
21. IsNumeric: checks whether it is numeric or not

?isnumeric(23)
True
?Isnumeric("34ab")
False
?isnumeric("45")
True
22. VAL: return the value from the given number cum string combination
?val("34sdfs")
34
?val("skfdsfs")
0
?val("")
0
?val(" ")
0
?val("sfdsf34")
0
?val(45)
45
23. Time :
?time
1:39:12 PM
?time$ '24 hours format
13:39:23
?now
11/1/2012 1:39:46 PM
?hour(time)
13
?minute(time)
40
?second(time)
14
?month(#23-oct-2012#)
10
24. Datediff:
Syntax: Datediff(Interval, date1, date2)
?datediff("m",#23-oct-2012#,#12-1-2014#)
26
?datediff("yyyy",#23-oct-2012#,#12-1-2014#)
2
?datediff("s",#23-oct-2012#,#12-1-2014#)
66441600
?datediff("w",#23-oct-2012#,#12-1-2014#)
109
VARIABLE
A temporary memory location (in RAM) that can be used by a program while the program is being run
After the execution the memory of all variables is claimed by the OS
Note:- Memory used by object variables must be cleared by using “NOTHING” key
 “Dim “ statement is used to declare variable

 Dim stands for Dimension
 Dim stamen can declare on or more variable
 Data type is separate for each variable
 Default data type in vba is VARIANT
Example: Dim <<variable_name>> [as datatype]
Dim a as integer
Dim x,y as integer ‘ x is a variant
Dim sal as double ‘ to store decimal variant
Dim filefound as Boolean ‘ true/false
Dim acno as string *16 ‘fixed length is 16
Dim ampname as string ‘ variable adjustable length

SCOPE OF A VARIABLE:
1. LOCAL VARIABLE: variables declared in a program(subprocedure/function procedure)

2. MODULE LEVEL VARIABLE: variables declared in general (declarations) section of a module that can be
accessed or used by all programs in that module
Example:
Dim a as integer ‘ Module level
Sub abc()
A=10
end sub
Sub deff()
Msgbox a
End sub
Sub ghi()
Abc ‘ calling other program

Deff ‘ calleing other program
End sub
Eample 2:
Sub operex()
Dim a As Integer, b As Integer
a = 11: b = 5 ' : is sued to write two separate statement in one line
MsgBox a + b
MsgBox a - b
MsgBox a / b
MsgBox a * b
MsgBox a ^ b
MsgBox a \ b
MsgBox a Mod b
MsgBox a & b
End Sub
INPUTBOX: Inputbox is used to read a value from the user
Syntax: INPUTBOX( prompt,[title],[default])
Promt: message
Title: text in title bar
Default: default value
Example:
Sub oper()
a = InputBox("enter first no")
b = InputBox("enter first no", "reading b", 4)
MsgBox " the result is " & a + b
End Sub
LOCAL WINDOW
Go to view menu -> local window
Displays the values of all variables in the current program in the break mode (step into mode : F8)
Note: 1. Variable can be used without declaring. 2. Those variables are VARIANT by default
OPTION EXPLICIT: To make variable declaration mandatory for all programs in the current module. OPTION
EXPLICIT can be used it is a module level statement that is applicable for all programs in the current module
Example:
Option Explicit
Sub opeex()
a = InputBox("enter first number")
b = InputBox("enter second no", "read b", 3)
MsgBox "the result is" & Val(a) + Val(b)
End Sub
Question: how to set OPTION EXPLICIT as default for all new modules?
Ans: Tools-> Options-> Editor -> required variable declaration
DATE : 27/10/12
IMPORTANT NOTE:
DATA DEFAULT
TYPE VALUES
STRING IS BLANK
VARIANT IS EMPTY
BOOLEAN IS FALSE
DATE IS 12:00 AM
INTEGER 0
BRANCHING/DECISION MAKING/CONTROL STATEMENTS
 Executing a block of codes based on the results of conditional statements

 VBA supports following structure to work with branching
a. IIF
b. IF
c. SELECT CASE
d. GOTO
A. IFF : it is also called inline if
Purpose: validate an expression and execute True/False part

True part or false part
Syntax: IIF(expression, truepart, falsepart)
Limitation: It can process multiple conditions but only one level
Example1:
Sub iifex()
Dim n As Integer
n = InputBox("enter n value", "read n", 23)
MsgBox IIf(n Mod 2 = 0, "even", "odd")
End Sub
Example2:
Sub iifex2()
Dim n As Integer
n = Cells(1, 1) 'read value from a1

Range("b1").Value = IIf(n Mod 2 = 0, "even", "odd")
End Sub
' Note: value property is optional
Example
Sub exam()
Dim n As Variant
n = InputBox("Enter N value", "Read N")
result = IIf(IsNumeric(n) = True, "Number", "Not a number")
MsgBox result
End Sub
Example3: Read data from excel
Sub iifex2()
Dim n As Integer
n = ActiveCell.Value 'read value from active cell
Range("b1").Value = IIf(n Mod 2 = 0, "even", "odd")
End Sub
Example4:
Sub iifex2()
Dim n As Integer
n = ActiveCell 'read value from active cell
'ActiveCell.Next = IIf(n Mod 2 = 0, "even", "odd")
ActiveCell.Previous = IIf(n Mod 2 = 0, "even", "odd")
End Sub
Example5:
Sub iffex3()
Dim n As Integer
n = ActiveCell.Value
'ActiveCell.Offset(0, 1) = IIf(n Mod 2 = 0, "even", "odd")
'ActiveCell.Offset(0, 2) = IIf(n Mod 2 = 0, "even", "odd")
'ActiveCell.Offset(-2, 0) = IIf(n Mod 2 = 0, "even", "odd")
ActiveCell.Offset(2, 0) = IIf(n Mod 2 = 0, "even", "odd")
End Sub
Example5:
Sub iffex()
Selection.Font.Bold = True
Selection.Offset(0, 3).Font.ColorIndex = 5
End Sub
Example: Check whether given value is a Number or not
Sub exam()
Dim n As String
Dim w As Worksheet
Set w = Sheets("sheet1")
Range("b:b").Clear
Dim i As Long
For i = 1 To w.UsedRange.Rows.Count
n = Cells(i, 1).Value
If n <> Empty Then
result = IIf(IsNumeric(n) = True, "Number", "Not a number")
Cells(i, 2) = result
End If
Next
Set w = Nothing
End Sub
B. IF statement
 IF is used to validate single or multiple level condition statements
 If an IF statement written in a single line, END IF is not required
 If an IF is written in multiple lines, it needs end IF
 To validate multi level conditions Else If required
 ELSE is optional in IF statement
 ELSE is used to handle false or default
Syntax 1: Single line
IF condition part THEN code
Syntax2: single line
IF conditional part THEN code else CODE
Syntax 3 : Multiline
IF conditional part then ‘true

Code
[Else ‘false
Code]
Syntax 4 : Multiline)
IF conditional part THEN

Code
Elseif conditional part then
Code
Elseif coditonal part then
Code
Else
Code
End if
NESTED IF
 One If block can be used in another block

 The inner block is called NESTED IF
EXAMPLE:
EXAPLE REQUIRED ****************
SELECT CASE
It is used to look for different values (cases) in a variable an expression and then to execute concerned
Purpose Example: display weekday name in reading weekday code
Syntax:
Select case var/expression
Case expected value1: action1
Case expected value2: action2
Case expected valuen: action
Case else : action x
End select
Example:
Sub seelctcaseexa()
w = InputBox("enter w value")
Dim res As String
Select Case w
Case 1: res = "sun"
Case 2: res = "mon"
Case 3: res = "tue"
Case 4: res = "wed"
Case 5: res = "thu"
Case 6: res = "fri"
Case 7: res = "sat"
Case Else: res = "wrong week code"

End Select
MsgBox res
End Sub
EXCEL BOJECT MODEL
Application: Excel
Workbooks: the collection of all opened workbooks
Workbooks (books name): one workbook from workbooks collections
Workbooks (index) : one workbook from workbook collections
Active workbook: the work book that is active in excel
Worksheets/sheets: the collections of all sheets in a workbook
Sheets(sheets_name) : One sheet from sheets collection
Sheets (Index) : One sheet from sheets collection by position
Activesheet : the sheet that is active in excel
Range: a collection of one or more cells
Cells: represent all cells in a sheet
Cells(rowindex, columnindex) – represent one cell
Other: page setup, font, conditional formats, pivoteta bles, listobjeccts(tables)
Note:1 Method – action(cut, copy), Properties- get/set items(name, address etc)
1. Working with range object
Sub rangeex()
'Range("a3").Value = Date
'Range("a2").Value = "sample data"
Range("a1:b20").Value = ("new text")
End Sub
2. Select Object
Sub exsss()
'Range("a10").Select
'Range("a1:b10").Select
'Range("a1:b10,d5:d8,k8").Select
'Range("a:a").Select ' complete column
Range("a:c,e:f,h20,k:k").Select
End Sub
Identify preselected data
?selection.address
$A:$C,$E:$F,$H$20,$K:$K
?selection.address
$1:$1048576,$E:$F,$H$20,$K:$K
Row Property
?range("a1:x20").Rows.Count
20
?range("b1:c23").rows.count
23
?selection.rows.count
1048576
?selection.columns.count
16384
Working with Font
Sub excap()
Range("a1:b6").Font.Name = "algeria"
Range("a1:b6").Font.Bold = True
Range("a1:b6").Font.Italic = True
Range("a1:b6").Font.ColorIndex = 5
End Sub
Color example
Note: there are 56 default colors in excel
Example:
Sub colorex()
Dim i As Integer
For i = 1 To 56
Cells(i, 1).Interior.ColorIndex = i
Next
End Sub
Purpose:
Sub coloexc()
Dim sh As Worksheet
Set sh = Sheets("sheet1")
For i = 1 To sh.UsedRange.Count
If Cells(i, 1).Value >= 95 Then
Cells(i, 1).Interior.ColorIndex = 34
ElseIf Cells(i, 1).Value >= 90 Then
ElseIf Cells(i, 1).Value >= 75 Then
Else
End If
Next
Set sh = Nothing
End Sub
Work with Cut
Syntax: Source range cut destinationrange

Sub cutex()
Range("a1:a7").Cut Range("b2")
End Sub
Example 2
Sub cutex()
Range("a8:a15").Cut Sheets("sheet2").Range("d2")
End Sub
Sub cutex()
Workbooks("book1").Sheets("sheet1").Range("a1:b10").Cut Workbooks("book2").Sheets("sheet1").Range("d10")
End Sub
Work with PasteSpecial
Use copy in place of cut
Ex 1:
'Range("a1:a5").Copy Range("b2")
Ex2
Range("b1:b8").Copy
Range("f1").PasteSpecial
Ex3
Sub passpex()
Range("a1:a5").Copy
Range("c1").PasteSpecial , xlPasteSpecialOperationNone
Application.CutCopyMode = False
End Sub
Ex4:
Sub passpex()
Range("a1:a5").Copy
Range("c1").PasteSpecial , xlPasteSpecialOperationAdd
End Sub
LOOP
Loop is program construct that repeats one or more lines of code
 Using a variable called I is a convention in a loop

 I – Iteration (Cycle)
VBA supports 3 loops
FOR : For is a number based loop i.e it runs for fixed no of times
Ex: Offer valid from Jan 1, 2013 to 5 Jan, 2013
While: is condition based i.e. as long as the condition is true
Do: is the condition based i.e as long as the condition is true
Ex: Offer valid till the stock is available
FOR LOOP:
Syntax: FOR variablename = start_value to End_value [stpep value]
Code to be repeat
Next [variable_name]
EX1
Example:
Sub forex()
Dim i As Integer
For i = 1 To 10
MsgBox "done"
Next
End Sub
Ex2
Print 1 to 10 numbers in immediate window
Sub forex()
Dim i As Integer
For i = 1 To 10
Debug.Print "abc"
Next
End Sub
EX3
Sub forex()
Dim i As Integer
For i = 1 To 10
Debug.Print i
Next
End Sub
Ex4
Sub forex()
Dim i As Integer
For i = 1 To 10 Step 2
Debug.Print i
Next
End Sub
Note: the default step value is 1
EX5
Print 10 to 1 numbers in immidate window
Sub forex()
Dim i As Integer
For i = 10 To 1 Step -1
Debug.Print i
Next
End Sub
EX6
Print 1 to 10 numbers in column A in sheet2 in active workbook
Sub forex()
Dim i As Integer
Cells.ClearContents ' to clear all cess data
For i = 1 To 10
Sheets("sheet2").Range("b" & i) = i
Next i
End Sub
EX7
Sub forex()
Dim i As Integer
For i = 1 To 10
'Sheets("sheet3").Cells(i, 1) = i
Sheets("sheet3").Cells(i, "a") = i
Next
End Sub
EX8
Print 10 to 1 in column A
Sub forex()
Dim i As Integer
Sheets("sheet1").Cells(11 - i, 1) = i
Next
End Sub
EX9
Sub forex()
Dim i As Integer, j As Integer
Cells.Clear
j=j+1
Cells(j, "a") = i
Next i
End Sub
EX10
Print 2 nd multiplication table
Sub forex()
Dim i As Integer
Cells.Clear
For i = 1 To 10
Cells(i, 1) = "2*" & i & "=" & 2 * I
Next i
End Sub
EX12
Print 1 to 100 in multiple columns
Criteria : 10 multiplier per column

Sub mulex()
Dim n As Integer, i As Integer, r As Integer
n = InputBox("enter n value", "n value", 10)
r = 1: c = 1
Cells.Clear
For i = 1 To n
Cells(r, c) = i
r=r+1
If r = 120 Then
r = 1: c = c + 1
End If
Next
End Sub
EX13 : column heading with macro headeing
Sub cheadex()
Dim y As Integer
y = 2011
Cells.Clear
Dim i As Integer
For i = 1 To 10
Cells(1, i + 1) = y + 1
Next
For i = 1 To 4
Cells(i + 1, 1) = "QTR" & i
Next
End Sub
Ex14
Extract numeric data from a cell
Sub extracnum()
Dim str As String
Dim i As Integer
Dim j As Integer
For j = 1 To 10
Cells(j, 2).Clear
str = Cells(j, 1)
For i = 1 To Len(str)
Dim Nums As String
'If IsNumeric(Mid(str, i, 1)) = True Then
'If UCase(Mid(str, i, 1)) Like "[0-9]" Then
'If Mid(str, i, 1) Like "[A-Z , a-z]" Then
'If Mid(str, i, 1) Like "[A-Z]" Then
If Not Mid(str, i, 1) Like "[A-Z , a-z, 0-9]" Then
Nums = Nums & Mid(str, i, 1)
End If
Next
Cells(j, 2) = Nums
Nums = blank
Next j
Columns.AutoFit
End Sub
Ex15
Find prime or not

Sub prmrno()
Dim i As Integer
n = InputBox("enter n value")
For i = 1 to n
If n Mod i = 0 Then
factor = factor + 1
End If
Next
If factor = 2 Then
MsgBox "prime"
Else
MsgBox "not prime"
End If
End Sub
Ex16
Remove commas at the end of the line
Sub speex()
Dim str As String
str = StrReverse([a1])
Dim i As Integer
If Mid(str, i, 1) <> "," Then
Exit For
End If
Next
[b1] = StrReverse(Mid(str, i))
End Sub
Ex17 : remove last comma
Function reccomon(str As String)
str = StrReverse(str)
Dim i As Integer
If Mid(str, i, 1) <> "," Then
Exit For
End If
Next
reccomon = StrReverse(Mid(str, i))
End Function
FOR EACH
For each loop can be used against object
EX1
Sub forec
Pprasad.hfm@gmail.com
EX2:
Repeat entries of column A in column C based on the values of Column B
Sub repex()
Dim i As Integer, rpt As Integer, rowno As Integer
For Each c In Range("a1:a10")
rpt = c.Next.Value
For i = 1 To rpt
Cells(rowno + i, 3) = c.Value
Next i
rowno = rowno + rpt

Next c
End Sub
Ex3
Sub repex()
Dim c, rpt As Integer, j As Long
rpt = c.Next.Value
Dim i As Integer
j=j+1
Cells(j, 3).Clear
For i = 1 To rpt
If Len(c.Next.Next.Value) = 0 Then
c.Next.Next.Value = c.Value
Else
c.Next.Next.Value = c.Next.Next.Value & "," & c.Value
End If
Next
Next
'Range("c:c").TextToColumns Range("c1"), comma:=True
Columns.AutoFit
End Sub
EX4 : search for required sheet name
Check whether the sheet exists or not
Sub sheetsexist()
Dim sheetname As String, shfound As Boolean
Dim i As Integer
sheetname = UCase(InputBox("enter sheet name", "reading sheet"))

Dim sh As Worksheet
For Each sh In Sheets
i=i+1
If UCase(sh.Name) = sheetname Then
shfound = True
Exit For
End If
Next
If shfound = True Then
MsgBox sheetname & ":" & "sheet sequence is :" & i & " found"
Else
MsgBox "out of " & i & " sheets " & sheetname & " sheet is not found"
End If
End Sub
EX: to find out a sheet in a very fast manner
Sub sheetfouex()
Dim sheetname As String
sheetname = InputBox("enter sheet name", "reading sheet name")
On Error GoTo Dothis
Sheets(sheetname).Name = sheetname
MsgBox sheetname & " is found"
Exit Sub
Dothis:
MsgBox sheetname & " is not found"
End Sub
WHILE LOOP
 This is condition based

 Runs as long as condition is true
 Ctrl + Break : to stop non-responding macros
Syntax:
While Condition part
Code
Wend
Example:
Sub printex()
Dim i As Integer
i=1
While i <= 10
Debug.Print i
i=i+1
Wend
End Sub
DO LOOP:
 Condition based
 While – pre check
 Do post check
 Runs the loop at least one time
Syntax:
Do
Code
Loop while/until conditional part
Note: While(after loop) runs the loop as long as the conditional part is true whereas until(after loop)runs the loop as long as the
conditional part is false
EX:
Sub printex()
Dim i As Integer
i=1
Do
Debug.Print i
i=i+1
Loop While i <= 10
End Sub
Example
Sub printex()
Dim i As Integer
i=1
Do
Debug.Print i
i=i+1
Loop Until i = 11
End Sub
Example:
How many words are there in excel
Sub wordcount()
Dim str As String
'using excel funtion in vba
str = Application.WorksheetFunction.Trim(Cells(1, 1))
Dim wcount As Integer, i As Integer
If Len(str) > 0 Then wcount = 1
If Mid(str, i, 1) = " " Then

wcount = wcount + 1
End If
Next
Cells(1, 2) = wcount
Columns.AutoFit
End Sub
Example:
Sub wordcount()
Dim str As String
Dim wcount As String, i As Integer
For j = 1 To 10
str = Application.WorksheetFunction.Trim(Cells(j, 1))
If Mid(str, i, 1) = " " Then
wcount = wcount + 1
End If
Next
Cells(j, 2) = wcount
wcount = blank
Next
Columns.AutoFit
End Sub
Example:
Sub wordcount()
Dim str As String
wcount = wcount + Len(str) - Len(Replace(str, " ", ""))
Columns.AutoFit
End Sub
Example : same
Sub wordcount()
Dim str As String
wcount = wcount + Len(str) - Len(Replace(str, " ", ""))
Columns.AutoFit
End Sub
Example:
Sub commamt()
Dim smat As Double, comm As Double, choice As Integer
Do
samt = InputBox("enter salse value")

If samt >= 50000 Then
comm = samt * 0.3
ElseIf samt >= 40000 Then
comm = samt * 0.2
ElseIf samt >= 20000 Then
comm = smat * 0.05
Else
comm = 1000
End If
MsgBox "salse is : " & samt & ", commission: " & Round(comm, 2)
choice = MsgBox("do u want to contiue?", vbYesNo + vbQuestion, "continue")
'Loop While choice = vbYes
Loop Until choice = vbNo
End Sub
Working with Wrd
 Purpose: create a docx from Macro

 Concept – late binding
 All objects are generic type
 Needs no libraries to be linked while writing code
 Version free
 Runs slowly
Example:
Sub wordex()
Dim w As Object, wd As Object
Set w = CreateObject("word.application")
Set wd = w.documents.Add
w.Visible = True 'default is false
w.Selection.typetext "this is for line 1"

w.Selection.typeparagraph
w.Selection.typetext "this is line 2"
wd.SaveAs "D:\prasadmacro.docx"
Set wd = Nothing
w.Quit
Set w = Nothing
End Sub
Example:
Working with Word
 Concept: early binary

 All objects are predefined type
 Needs related liabratry to be linked while writing code(at runtime)
 Tools->reference-> Ms Word 12.0 object library
 Not version free
 Runs fast
 Class: Rules and regulation for object Example: Internally “worksheet”

 Object: an instance of a class Ex: Sheet1, Sheet2 and Sheet3
 Property : set or get item Ex: Sheet name, tab color, protection , no of rows etc
 Method: action Ex: copy or paste
 Constant: Fixed item Ex: VbYes
 Enumerator: List of related constants Ex: Msgbox result
Working with Power point
Sub pptex()
Dim ppt As PowerPoint.Application
Dim pps As PowerPoint.Presentation
Set ppt = CreateObject("powerpoint.application")
ppt.Visible = True
Set pps = ppt.Presentations.Add

pps.Slides.Add 1, 8 'ppt layout check
Sheets("sheet1").ChartObjects(1).Copy
ppt.ActiveWindow.View.Paste
pps.SaveAs "d:\newppt.pptx"
pps.Close
Set pps = Nothing
ppt.Quit
Set ppt = Nothing
End Sub
Ex 2
Working with Outlook: we can directly send mails through VBA
Sub pptex()
Dim otl As Object, m As Object
Set otl = CreateObject("outlook.application")
Set m = otl.createitem(0) ' create a new outlook item in outlook
m.To = "abc@yahoo.com"
m.Subject = "Main"
m.body = "just noting"
m.attachment = "C:\abc.txt"
m.send
otl.Quit
Set otl = Nothing
Set m = Nothing
End Sub
Example 2 ‘ send mail with function
Sub sendml()
sendml "abc@gmail.com", "hi", "hi as asd dfdf fdf", "c:\abc.txt"
End Sub
' a User defined Function to send mails through outlook
Function sendml(sendto, subject, body, attachment)
End Function
Dim otl As Object, m As Object
Set otl = CreateObject("outlook.application")
Set m = otl.createitem(0) ' create a new outlook item in outlook
m.To = sendto
m.subject = subject
m.body = body
If attachment <> "" Then
m.attachment = attachment
End If
m.send
otl.Quit
Set m = Nothing
Set otl = Nothing
End Function
Working with File system:

File system is nothing but windows files
Those are : Drives, subfolders and files
Scripting.filesystemobject – FSO
Example:
TV - > DVD Player - > DVD
VBA -> scripting.FSO -> Filesystem(subfolders,drives, and files)
Example1: to know how many drivers are there in your system
Sub getdrive()
Dim fs As Object
Set fs = CreateObject("scripting.filesystemobject")
Dim d, i As Integer
Cells.Clear
For Each d In fs.drives
i=i+1
Cells(i, 1) = d
Next
Cells(i + 1, 1) = "total drives : " & fs.drives.Count
End Sub
Example2
Sub subfolders()
Dim fs As Object, fol As Object, fpath As String
fpath = "d:\"
Set fol = fs.getfolder(fpath)
Dim f, i As Integer
Cells.Clear
For Each f In fol.subfolders
i=i+1
Cells(i, 1) = f.Name
Next
Cells(i + 1, 1) = "total sub folders:" & fol.subfolders.Count
Cells(i + 1, 1).Font.Bold = True
Cells(i + 1, 1).Interior.ColorIndex = 7
Columns.AutoFit
Set fol = Nothing
Set fs = Nothing
End Sub
Ex : Get files and its type
Sub getfiles()
Dim fs As Object, fol As Object, fpath As String
fpath = "D:\Others\foster"
Cells.Clear
Cells(1, 1) = "name"
Cells(1, 2) = "type"
Cells(1, 3) = "extension"
Cells(1, 4) = "size"
Cells(1, 5) = "date created"
Cells(1, 6) = "date modified"
Cells(1, 7) = "path"
Dim f, i As Integer
i=1
For Each f In fol.Files
i=i+1
Cells(i, 1) = f.Name
Cells(i, 2) = f.Type
'Cells(i, 3) = f.getextensionname(f.Name)
Cells(i, 4) = f.Size
Cells(i, 5) = f.datecreated
Cells(i, 6) = f.datelastmodified
Cells(i, 7) = f.Path
Next
Cells(i + 1, 1) = "total sheets : " & fol.Files.Count
Cells(i + 1, 1).Font.Bold = True
Columns.AutoFit
Set fol = Nothing
Set fs = Nothing
End Sub
Purpuse:
User select files form a required folder(single folder selection)
Sub exce()
Dim fol As Object, fpath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select A Folder"
.InitialFileName = "c:\"
.Show
fpath = .SelectedItems(1)
End With
MsgBox fpath
End Sub
Purpose: how to run macro on selected files only in a folder
Sub exce()
Cells.Clear
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select on or more files"
.InitialFileName = "C:\"
'.AllowMultiSelect = True
.Show
Dim f, i As Integer
For Each f In .SelectedItems
i=i+1
Cells(i, 1) = f
Next
End With
Columns.AutoFit
End Sub
Purpose: How to run macro on selected file type
Sub exce()
Cells.Clear
.Filters.Clear
.Filters.Add Description, expression
.Filters.Add "excel files", "*.xlsx,*.xlsm"
.Filters.Add "imagefiels", "*.jpg; *.bmp"
.Title = "select one or more files"
.InitialFileName = "c:\"
.AllowMultiSelect = True
.Show
Dim f, i As Integer
For Each f In .SelectedItems
i=i+1
Cells(i, 1) = f
Next
End With
Columns.AutoFit
End Sub
Purpose: Convert selected worksheeds into pdf files
Sub exce()
Dim fol As Object, fpath As String
Cells.Clear
.Show
End With
Dim fs As Object
Dim f, i As Integer
If UCase(fs.getextensionname(f.Name)) = "XLSX" Then
i=i+1
Workbooks.Open f.Path
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\abc" & i & ".pdf"
ActiveWorkbook.Close
End If
Next
MsgBox "Excel files are converted to PDF", vbInformation
End Sub
Purpuse: each sheet converts as one pdf
Purpose: Assign sheet names as moths
Sub workshname()
Dim i As Integer
Worksheets.Add Count:=9
If Sheets.Count <= 12 Then
For i = 1 To Sheets.Count
Sheets(i).Name = Left(MonthName(i), 3) & "-2012"
Next i
End If
End Sub
Purpuse:
Sub workshname()
Dim ycount As Integer, shCount As Integer, StrYear As Integer
StrYear = InputBox("enter start year")
ycount = InputBox("No of years")
Dim y As Integer, s As Integer
For y = 1 To ycount
For s = 1 To 12
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = Left(MonthName(s), 3) & "_" & StrYear + y - 1

Next s
Next y
End Sub
Purpose:
Sub jan2decassheetnames()
Dim prevshcount As Integer
prevshcount = Sheets.Count
Dim ts As Worksheet, s As Integer, i As Integer
Set ts = Sheets.Add(after:=Sheets(Sheets.Count))
For s = 1 To prevshcount
i=i+1
ts.Cells(i, 1) = Sheets(i).Name
Next
Dim yrcount As Integer, shcount As Integer, startyear As Integer
startyear = InputBox("Enter the start year")
yrcount = InputBox("No of Years")
Dim y As Integer
For y = 1 To yrcount
For s = 1 To 12
ActiveSheet.Name = Left(MonthName(s), 3) & "_" & startyear + y - 1
Next
Next
'Ctrl+F8 : run to cursor
Application.DisplayAlerts = False
For Each c In ts.Range("a1:a" & prevshcount)
Sheets(c.Value).Delete
Next
ts.Delete
Application.DisplayAlerts = True
End Sub
Purpose:
Sub jan2decasSheetNames()
Workbooks.Add
On Error Resume Next 'Ignore errors and resume next
Application.DisplayAlerts = flse
sh.Delete
Next
Dim s As Integer, yrcount As Integer, shcount As Integer, startyear As Integer
startyear = InputBox("Enter Start Year")
yrcount = InputBox("no of year")
Dim y As Integer
For y = 1 To yrcount
For s = 1 To 12
ActiveSheet.Name = Left(MonthName(s), 3) & "_" & startyear + y - 1
If y = 1 And s = 1 Then Sheets(1).Delete
Next
Next
End Sub
Consolidation of data from different sheets:
Purpose: Consolidate all sheets into one

Sub consolidateex()
Dim ws As Worksheet
Set ws = Sheets.Add(before:=Sheets(1)) 'As a first sheet
'Set ws = Sheets.Add(after:=Sheets(Sheets.Count)) ' ' As a last one
ws.Name = "Summary"
Dim sh, HeadingCopied As Boolean
applicaiton.ScreenUpdating = False
If sh.Name <> "Summary" Then
If HeadingCopied = flase Then
sh.UsedRange.Copy ws.Range("a1")
HeadingCopied = True
Else
sh.Range("2:" & sh.UsedRange.Rows.Count).Copy ws.Range("a" & ws.UsedRange.Rows.Count + 1)
End If
End If
Next
Set ws = Nothing
Application.ScreenUpdating = False
End Sub
Purpose: To find out required sheet exist or not
Sub findShName()
Dim sname As String
sname = InputBox("Enter sheet name")
Dim sh, shfound As Boolean
If UCase(sh.Name) = UCase(sname) Then

shfound = True
Exit For
End If
Next
If shfound = True Then
MsgBox sname & " Sheet Found"
Else
MsgBox sname & " :Sheet Not Found"
End If
End Sub
Purpose: Delete hidden sheets from excel
Sub DeleteHiddenSheets()
'
' Remove hidden sheets from your document
'
i=1
While i <= Worksheets.Count
If Not Worksheets(i).Visible Then
Worksheets(i).Delete
Else
i=i+1
End If
Wend
End Sub
Purpuse:
Sub consolidateFromAllWbksFromSelFolder()
'select source folder
Dim folpath As String
.Show
folpath = .SelectedItems(1)
End With
'select target file
Dim fpath As String
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
.AllowMultiSelect = False
.Show
End With
'open target file
Dim tgtwbk As Workbook
Set tgtwbk = Workbooks.Open(fpath)
Dim fs As Object, srcwbk As Workbook
Dim fol As Object
Set fol = fs.getfolder(folpath)
Dim f, i As Integer, HeadingsCopied As Boolean, Frow As Long, Lrow As Long, _

NextRowInTgt As Long
If UCase(fs.getExtensionName(f.Name)) = "XLSX" Then
Set srcwbk = Workbooks.Open(f.Path)
If HeadingsCopied = False Then
'copy with headings
For i = 1 To tgtwbk.Sheets.Count
srcwbk.Sheets(i).UsedRange.Copy tgtwbk.Sheets(i).Range("a1")
Next
HeadingsCopied = True
Else
'copy without headings
For i = 1 To tgtwbk.Sheets.Count
Frow = srcwbk.Sheets(i).UsedRange.Row
Lrow = Frow + srcwbk.Sheets(i).UsedRange.Rows.Count - 1
NextRowInTgt = tgtwbk.Sheets(i).UsedRange.Rows.Count + 1
srcwbk.Sheets(i).Range(Frow + 1 & ":" & Lrow).Copy _
tgtwbk.Sheets(i).Range("a" & NextRowInTgt)
Next
End If
srcwbk.Close False 'close without saving
Set srcwbk = Nothing
End If
Next
tgtwbk.Close True
Set tgtwbk = Nothing
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Purpose:
Sub consolidateEx()
'all sheets into one
Dim ws As Worksheet, HeadRows As Integer
HeadRows = InputBox("No. of rows in heading ")
Dim sname As String
sname = "summary"
Dim s, shFound As Boolean
For Each s In Sheets
If UCase(s.Name) = UCase(sname) Then
shFound = True
Exit For 'quits current for loop
End If
Next
If shFound = True Then
Sheets("Summary").Cells.Clear
Set ws = Sheets("summary")
Else
'first sheet
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
'last sheet
'Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
End If
Dim sh As Worksheet, HeadingsCopied As Boolean 'false
If sh.Name <> "Summary" Then
If HeadingsCopied = False Then
'copy with headings
sh.UsedRange.Copy ws.Range("a1")
HeadingsCopied = True
Else
'copy without headings
sh.Range(sh.UsedRange.Row + HeadRows & ":" & sh.UsedRange.Rows.Count).Copy _
ws.Range("a" & ws.UsedRange.Rows.Count + 1)
End If
End If
Next
Set ws = Nothing: Set sh = Nothing
Application.ScreenUpdating = True
End Sub
Sub findSheet()
Dim sname As String
sname = InputBox("Enter sheet-name")
Dim sh, shFound As Boolean
If UCase(sh.Name) = UCase(sname) Then
shFound = True
Exit For 'quits current for loop
End If
Next
If shFound = True Then
MsgBox sname & " sheet found"
Else
MsgBox sname & " sheet NOT found"
End If
End Sub
08/12/2012
Purpose: Delete empty sheets from a workbook
Sub deleteEmptyShs()
Dim sh
On Error Resume Next
Application.DisplayAlerts = flase
If IsEmpty(sh.UsedRange) Then
sh.Delete
End If
Next
End Sub
Purpose: Filter and Copy
Sub filterNCopy()
Dim t
t = Now()
Dim ws As Worksheet
Set ws = Sheets("sheet1")
Dim ts As Worksheet
'Application.ScreenUpdating = False
'the above line stops the excel screen update for each line of code and speed up execution
Set ts = Sheets.Add(after:=Sheets(Sheets.Count))
ws.Range("a:a").Copy ts.Range("a1")
ts.UsedRange.RemoveDuplicates 1, xlYes
Dim c
For Each c In ts.UsedRange
If c.Row > 1 Then
ActiveSheet.Name = c.Value
'ws.UsedRange.AutoFilter field, criteria
ws.UsedRange.AutoFilter 1, c.Value
ws.UsedRange.Copy ActiveSheet.Range("a1")
End If
Next
ws.UsedRange.AutoFilter
ws.Activate
ts.Delete
'Application.ScreenUpdating = True
MsgBox "Time Taken " & DateDiff("s", t, Now) & "seconds"
Set ws = Nothing
Set ts = Nothing
End Sub
Purpose: To Know the performance of the program
Sub colorcells()
Dim t
t = Now()
'Application.ScreenUpdating = False
Dim i As Integer, j As Integer
For i = 1 To 100
For j = 1 To 56
Range("a1:b500").Interior.ColorIndex = j
Next j
Next i
'Application.ScreenUpdating = True
MsgBox " Time taken" & DateDiff("S", t, Now) & "Seconds"
End Sub
Example: Remove last commas with Subroutine : Issue
Sub removelastcom()
Dim str As String
str = Cells(1, 1)
Dim i As Integer
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) Like "[a-z;A-Z;0-9]" Or _
InStr("[]", Mid(str, i, 1)) Then Exit For
Next
Cells(2, 1) = Left(str, i)
End Sub
Example: Remove last commas with Function
ARRAYS
Array: -
 A variable that can store multiple values

 The elements of an array are stored in adjacent cells in memory
 Arrays are faster than ranges
 An array may be single dimension or multiple dimensions
 Single dimension: a list of items
 Multiple dimensions: a set of rows or coloms/multiple set of rows and colums
 Max dimensions are 60
 An array may be fixed dynamic in size
 Note: Dynamic means adjustable in size
 General declaration of an array Ex: Dim variablename(size) as datatype
Ex: Dim a(1 to 5) as string
This array can store 5 string values
 Ex: Dim a(101 to 150) as string , this array can store 50 string values
 Dim a(1 to 5) as string
1 is the lowerbound(Min Index)
5 is the Upperbound(Max Index)
 If lower bound and upper bound are mentioned in syntax it is called EXPLICT DECLARATION
 If lower bound and upper bound are not mentioned in syntax it is called IMPLICIT DECLARATION
Ex: Dim cities(5) as string
The default lowerbound for arrays with implicit declaration is based on OPTION BASE statement
a. OPTION BASE is a module level statement
b. OPTION BASE can be 0 or 1
c. “ “ has no impact on explicit array
d. “ “ is applicable for all IMPLICIT arrays in all programs in the current module
Note: Lbound and Ubound are used to find out lower bound and upper bound of an array respectively usage
Single dim:
Lbound(arrayname)/Ubound(arrayname)
Multi dim:
Lbound(arrayname, dimension no)/ Ubound(arrayname, Dimension No)
Example: static array
Sub arrayex()
Dim cities(1 To 3) As String
cities(1) = "Hyd"
cities(2) = "Bang"
cities(3) = "Delhi"
'Get Lbound and Ubound
MsgBox LBound(cities)
MsgBox UBound(cities)
'Get an element
MsgBox cities(2)
End Sub
Option Base 1
Sub arrex()
Dim cities(3) As String ' Lbound is 1 because option base is 1
'cities(0) = " Sample"
cities(1) = "Hyd"
cities(2) = "Bang"
cities(3) = "Delhi"
'get lbound and ubound
MsgBox LBound(cities)
MsgBox UBound(cities)
'get an element
MsgBox cities(1)
End Sub
Read data from excel into array variable
Option Base 1
Sub arrex()
Dim a(3) As Integer

'get data from excel
Dim i As Integer
For i = 1 To 3
a(i) = Cells(i, 1)
Next
End Sub 'Ctrl+F8 -> run to cursor, view-> local window, expand
Example: Dynamic Array
Option Base 1
Sub arrayex()
'dynamic array: Adjustable size
'Note:- there is no initial size
Dim a() As Integer
Dim n As Integer
n = ActiveSheet.UsedRange.Rows.Count
'Note: Redim statemnet is used to resize a dynaic array
'Note: PRESERVE keyword is used to keep the existing data unearased in the current array while resize
ReDim a(n)
Dim i As Integer
' for i = 1 to n
For i = LBound(a) To UBound(a)
a(i) = Cells(i, 1)
Next i
ReDim Preserve a(n + 1)
'redim preserve a(ubound(a)+1)
End Sub
Purpuse: arrange the values in array variable in ascending order

Option Base 1
Sub arrayex()
Dim a() As Integer
n = ActiveSheet.UsedRange.Rows.Count
ReDim a(n)
Dim i As Integer
a(i) = Cells(i, 1)
Next
'sort values
Dim j As Integer, tempval As Integer
For j = LBound(a) To UBound(a)
If a(i) < a(j) Then
tempval = a(i)
a(i) = a(j)
a(j) = tempval
End If
Next
Next
End Sub
09/12/2012
Example: Check variant type in array
Sub variantex()
Dim a
a = Array(1001, "allen", "manager", #6/23/2012#)
MsgBox a(3)
End Sub
Example:
Sub importdatafromaTextfileWithDelimeter
Sub importdatafromaTextfileWithDelimeter()
Dim fs As Object, f As Object
Set f = fs.opentextfile("D:\new tex.txt", 1)
'1- read, 2- overwrite, 8- apppend(add to the existing data)
Dim r As Long, str As String
While f.atendofline <> True
s = f.readline
Dim a, i As Integer
'a = split(s,",")
a = Split(s, Chr(vbKeyTab))
'Note: Lbound is 0 by default when u use split key word
r=r+1
'Cells(r, i + 1) = a(i)
If Left(a(i), 1) = "0" Then
Cells(r, i + 1) = "'" & a(i)
Else
Cells(r, i + 1) = a(i)
End If
Next
Wend
With Range("1:1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.Underline = True
End With
Columns.AutoFit
Set fs = Nothing
Set f = Nothing
End Sub
Exmple: Diesal consumption program
Sub getmaxoflast2daydesalConsum()
Dim StrIndusID As String
StrIndusID = InputBox("Enter Indus ID")
Dim ws As Worksheet
Set ws = Sheets("sheet2")
ws.UsedRange.AutoFilter 1, StrIndusID
Dim c, dc As Double
For Each c In ws.UsedRange.SpecialCells(xlCellTypeVisible)
If c.Column = 4 And c.Row > 1 Then
If DateDiff("d", c.Value, Date) = 1 Or DateDiff("d", c.Value, Date) = 2 Then
dc = dc + c.Previous.Value
End If
End If
Next
ws.UsedRange.AutoFilter
MsgBox dc
End Sub
Example:
Multi-dimensional Arrays:
Option Base 1
Sub multidim()
Dim a(1 To 4, 1 To 3) As Integer
Dim r As Integer, c As Integer
For r = LBound(a, 1) To UBound(a, 1)
For c = LBound(a, 2) To UBound(a, 2)
a(r, c) = Cells(r, c)
Next
Next
End Sub
Example:
Option Base 1
Sub multidim()
Dim a(1 To 4, 1 To 3) As Integer
Next
Next
End Sub
Example”:
Sub multidimex()
Dim a(1 To 4, 1 To 3)
Next
Next
'Modify data from -ve to +ve
If a(r, c) < 0 Then a(r, c) = Abs(a(r, c))
Next
Next
Cells(r, c) = a(r, c)
Next
Next
End Sub
Example:
Sub variantarraywithrange()
Dim a, rng As Range
Set rng = ActiveSheet.UsedRange
a = rng ' now a is a 2 dim array
'lbound for all dimensions is 1 by default
'first element -> a(1,1)
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
If a(r, c) < 0 Then a(r, c) = Abs(a(r, c))
Next
Next
rng = a
Set rng = Nothing
End Sub
Example: Not an array program
Sub N2FOREACH()
For Each c In ActiveSheet.UsedRange
If c.Value < 0 Then
c.Value = Abs(c.Value)
End If
Next
End Sub
Example:
Sub n2pwithforeach()
Dim c
For Each c In ActiveSheet.UsedRange.SpecialCells _
(xlCellTypeConstants, xlNumbers)
If c.Value < 0 Then c.Value = Abs(c.Value)

Next
End Sub
Example:
Work on Text
UDF – User defined Function
 A workbook can have n no of UDF

 Too many UDFs may reduce the performance
 UDF is mandatorily written in modules
 UDF s are not seen under list of macros
 To view UDFs - > Shift+F3(Insert Function) - > user defined category
 UDFs in one workbook can be called from another (=Workbookname.functionname(list of argument)
 UDFs can be called from other UDF, built in and subprocedure
 When a UDF is called from a cell in excel it cannt do structural modifications susch as cut, copy, color, format etc.
 Generally UDFs are used to process based on the argument(values passed to a UDF) and return a value
Syntax:
Function <function name>([parameters]) [as datatype])
Code
End Function
Parameters: The variables defined inside ( ) in the function declaration
Note: These parameters work as placeholders for the values supplied while using the UDF
Arguments: The actual values supplied to a UDF while using it
Example: 1
Sub sample()
Dim str As String, TempStr As String
str = Range("a1")
Dim i As Integer
If Mid(str, i, 1) Like "[0-9]" Then
TempStr = TempStr & Mid(str, i, 1)
End If
Next
Range("b1") = TempStr
End Sub
Function GetNum(str As String)
'Input in normal programs is a parameter in UDF
Dim TempStr As String
Dim i As Integer
End If
Next
'Output is passed to the name of UDF
GetNum = TempStr
End Function
Example 2
Sub callgnums()
Dim c As Range

c.Next = GetNum(c.Value)
Next
Set c = Nothing
End Sub
Private Function GetNum(str As String)
Dim i As Integer
End If
Next
GetNum = TempStr
End Function
Example 3
Sub callgnums()
Dim s As String
s = InputBox("Enter a string")
MsgBox GetNum(s)
End Sub
Private Function GetNum(str As String)
Dim i As Integer
End If
Next
GetNum = TempStr
End Function
Example 4

VBA Notes

Uploaded by

VBA Notes

Uploaded by

VBA

1991-1998 VB 1.0 – 6.0

 In MS Office -2007, complete vba features

1. VB: is a software to develop new application software

2. VBA: it is used to enhance or automate manual tasks in the an existing software

- Enable Developer Tab(MS office 2007)

- Alt+F11 -> to go to VB editor

Note: Alt+F11 is used to switch bw excel and VBE

Alt+Q close VBE

 Programs written or recoded to automate the tasks.

Click record macro button on the start bar

i. Max 255 Characters

ii. Spaces are not allowed

iii. underscore can be used

iv. First Character must be a letter

Note: VBA is not case sensitive

Shortcut key (Optional)

Note: * shortcut keys are case sensitive

 Shortcut keys can be overwritten

First time personal .xlsb must be saved in excel or vbe

How to view personal .xlsb from excel

View tabs -> unhide -> personal -> ok

Note: by default there is only one work sheet in pmw

Place to work notes, purpose, summary etc

NOTE: By default recoded macros use absolute reference

USE RELATIVE REFERENCE

By default all macros are disabled (with notification)

VBA IDE(Visual Basic Editor)

Standard tool bar: contains frequently used menu commands as buttons

Project Explorer (Ctrl + R)

This window displays all open workbooks as VBA projects

A VBA project can have forms, modules, class modules

By default recorded macros are stored in modules

sub: sub procedure

blue color are key words

green means comments

‘ is used to comment a line or part of line

Commented lines are non-executable

To comment/uncomment a block of lines

Use comment block/uncomment block from edit tool bar

VIEW THE CODE OF A MACRO

There are two ways

 open VBE(Alt + F11)

ALT + F8 - > select macro -> click edit

 Navigation login code window

i. Full module review: displays all programs in the current module

Object drop down list:

PROCEDURE DROP DOWN LIST

Displays procedure for the currently selected objects

PROPERTIES WINDOW (F4)

 This window is used to execute any VBA statement

The above are used with IF Statement

2. STRING (one or more characters)

b. Variable length string max 2^ 31

3. DATE : date and time

4. Boolean : true / false

WRITING THE MACRO

 Press F5 in VBA to run macro

RUN MACRO FROM EXCEL

ADDING MACRO TO QUICK ACCESS TOOL BAR

ASSOCIATE A MACRO WITH AN IMAGE

 Insert shape smiley face

BUILT IN FUNCTIONS IN VBA

1. ABS : Return positive or absolute value

2. ASC : Returns ASCCI value

4. FIX (returns integer part (no decimal part)

6. LEN : length of the character

7. LEFT : returns no of characters from left

8. RIGHT: returns the required no of characters from right

9. MID(string, start, length) : return the no of characters from given position

?Strconv("abC DefG HesEho", vbProperCase)

Abc Defg Heseho

15. REPLACE: REPLACE(string, find , replace)

16. SGN: return sign of a number

17. TRIM: removes initial and last spaces

21. IsNumeric: checks whether it is numeric or not