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()

Dim a As Integer, b As Integer

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()
Dim a As Integer, b As Integer

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

Cells(i, 1).Interior.ColorIndex = 35

ElseIf Cells(i, 1).Value >= 75 Then

Cells(i, 1).Interior.ColorIndex = 36

Else

Cells(i, 1).Interior.ColorIndex = 37

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

Application.CutCopyMode = False

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

For i = 10 To 1 Step -1

Sheets("sheet1").Cells(11 - i, 1) = i

Next

End Sub

EX9

Sub forex()

Dim i As Integer, j As Integer

Cells.Clear

For i = 10 To 1 Step -1

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

For i = 1 To Len(str)

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

For i = 1 To Len(str)

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

For Each c In Range("a1:a10")

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

For i = 1 To Len(str)

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

'using excel funtion in vba

Dim wcount As String, i As Integer

For j = 1 To 10

str = Application.WorksheetFunction.Trim(Cells(j, 1))

If Len(str) > 0 Then wcount = 1

For i = 1 To Len(str)

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

'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

wcount = wcount + Len(str) - Len(Replace(str, " ", ""))

Cells(1, 2) = wcount

Columns.AutoFit

End Sub

Example : same

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

wcount = wcount + Len(str) - Len(Replace(str, " ", ""))

Cells(1, 2) = wcount

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

Application.CutCopyMode = False

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

Set fs = CreateObject("scripting.filesystemobject")

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

Set fs = CreateObject("scripting.filesystemobject")

fpath = "D:\Others\foster"

Set fol = fs.getfolder(fpath)

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

With Application.FileDialog(msoFileDialogFilePicker)

.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

With Application.FileDialog(msoFileDialogFolderPicker)

.Show

fpath = .SelectedItems(1)

End With

Dim fs As Object

Set fs = CreateObject("scripting.filesystemobject")

Set fol = fs.getfolder(fpath)

Dim f, i As Integer

For Each f In fol.Files

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

Sheets.Add after:=Sheets(Sheets.Count)

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

For Each sh In Sheets

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

Sheets.Add after:=Sheets(Sheets.Count)

ActiveSheet.Name = Left(MonthName(s), 3) & "_" & startyear + y - 1

If y = 1 And s = 1 Then Sheets(1).Delete

Next

Next

Application.DisplayAlerts = True

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

For Each sh In Sheets

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

For Each sh In Sheets

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

With Application.FileDialog(msoFileDialogFolderPicker)

.Show

folpath = .SelectedItems(1)

End With

'select target file

Dim fpath As String

With Application.FileDialog(msoFileDialogFilePicker)

.Filters.Clear

.Filters.Add "Excel Files", "*.xlsx"

.AllowMultiSelect = False

.Show

fpath = .SelectedItems(1)

End With

'open target file

Dim tgtwbk As Workbook

Set tgtwbk = Workbooks.Open(fpath)

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Dim fs As Object, srcwbk As Workbook

Set fs = CreateObject("scripting.filesystemobject")

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

For Each f In fol.Files

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.DisplayAlerts = True

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

Application.ScreenUpdating = False
 For Each sh In Sheets

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

For Each sh In Sheets

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

For Each sh In Sheets

If IsEmpty(sh.UsedRange) Then

sh.Delete

End If

Next

Application.DisplayAlerts = True

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

Sheets.Add after:=Sheets(Sheets.Count)

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

Application.DisplayAlerts = False

ts.Delete

Application.DisplayAlerts = True

'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

Example: static array

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

Example: static array

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)

'get data from excel

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)

'get data from excel

Dim i As Integer

For i = LBound(a) To UBound(a)

a(i) = Cells(i, 1)

Next

'sort values

Dim j As Integer, tempval As Integer

For i = LBound(a) To UBound(a)

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 fs = CreateObject("scripting.filesystemobject")

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

For i = LBound(a) To UBound(a)

'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

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”:

Sub multidimex()

Dim a(1 To 4, 1 To 3)

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

'Modify data from -ve to +ve

For r = LBound(a, 1) To UBound(a, 1)

For c = LBound(a, 2) To UBound(a, 2)

If a(r, c) < 0 Then a(r, c) = Abs(a(r, c))

Next

Next

For r = LBound(a, 1) To UBound(a, 1)

For c = LBound(a, 2) To UBound(a, 2)

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)

Dim r As Integer, c As Integer

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

For i = 1 To Len(str)

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

For i = 1 To Len(str)

If Mid(str, i, 1) Like "[0-9]" Then

TempStr = TempStr & Mid(str, i, 1)

End If

Next

'Output is passed to the name of UDF

GetNum = TempStr

End Function

Example 2

Sub callgnums()

Dim c As Range

For Each c In Range("a1:a6")

 c.Next = GetNum(c.Value)

Next

Set c = Nothing

End Sub

Private Function GetNum(str As String)

Dim TempStr As String

Dim i As Integer

For i = 1 To Len(str)

If Mid(str, i, 1) Like "[0-9]" Then

TempStr = TempStr & Mid(str, i, 1)

End If

Next

'Output is passed to the name of UDF

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 TempStr As String

Dim i As Integer
For i = 1 To Len(str)

If Mid(str, i, 1) Like "[0-9]" Then

TempStr = TempStr & Mid(str, i, 1)

End If

Next

'Output is passed to the name of UDF

GetNum = TempStr

End Function

Example 4