1.

Sub demo()

MsgBox "Hello World"

End Sub

2.

Sub demo()

'MsgBox "Hello World"

Worksheets(3).Select

Range("A1") = "NIBM"

End Sub

Sub demo()

'MsgBox "Hello World"

'Worksheets(4).Select

'Range("A1") = "NIBM"

MsgBox Worksheets.Count

End Sub

Sub demo()

'MsgBox "Hello World"

'Worksheets(4).Select

'Range("A1") = "NIBM"

'MsgBox Worksheets.Count

MsgBox Sheets.Count 'counts also the chart sheet along with other ssheets

End Sub

5 Range charancteristics

Sub try()

'Range("c:c") = 100

'Range("imput").Value = 10000
 Range("D1:D10").Font.Color = vbRed

Range("D1:D10").Font.Bold = True

End Sub

6 Range Characteristics

Sub try()

'Range("c:c") = 100

'Range("imput").Value = 10000

'Range("D1:D10").Font.Color = vbRed

'Range("D1:D10").Font.Bold = True

'Range("A1:E100").ClearContents

'Range("A1:E100").Clear 'not only remove the contents but settings also

'Cells(1, 1) = 100

'Range(Cells(1, 1), Cells(10, 1)) = "ABCD"

Range("A5").Cells(5, 2) = "NIBM" 'from A5 go 5 row and 2 colums below and write NIBM

End Sub

7 Copy Paste

Sub trial()

'Range("B1:B20").Copy Range("M1") paste at specified location

'Range("B1:B20").Copy ActiveCell 'paste at the cell in which you are present

Range("B1:B20").Copy

Sheets(3).Select

Cells(1, 15).Select

ActiveSheet.Paste

End Sub

8 Paste Special

Sub Macro1()

'

' Macro1 Macro

' Keyboard Shortcut: Ctrl+o

'

Sheets(4).Select

Range("C204:F219").Copy

Sheets("Ratios").Select

Range("K2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End Sub

Sub demo()

MsgBox "The no of columns are : " & Selection.Columns.Count

MsgBox "The no of rows are : " & Selection.Rows.Count

End Sub

10 : Loan Schedule

Sub demo()

Dim per As Integer

Dim rg As String

per = Range("B1")

rg = "A8:D" & per + 6

Range("A8:D1000").ClearContents

Range("A7:D7").Copy Range(rg)

End Sub

11 ListBoxWithMacro

Sub trial()

Dim mon As Integer

Sheets(2).Select

mon = Range("C1")
 Sheets(1).Select

Range(Cells(1, 1 + 3 * mon), Cells(22, 1 + 3 * mon)).Copy

Sheets(2).Select

Range("F1").Select

Selection.PasteSpecial Paste:=xlPasteValues

End Sub

12 Worksheet function

Sub stat()

'MsgBox VBA.Sqr(25)

'MsgBox VBA.UCase("nibm")

'num = WorksheetFunction.Count(Range("B2:M22"))

'MsgBox num

MsgBox WorksheetFunction.Pmt(0.12 / 12, 60, -200000)

End Sub

13 Related to concepts of Worksheetfunction

Sub stat()

Dim yr, brno As Integer

Dim rg As String

Dim sm, avg, max, min As Double

Sheets("Summary").Select

yr = Range("E7")

brno = Range("E9")

Sheets(WorksheetFunction.Text(yr, 0)).Select

rg = "B" & brno + 1 & ":M" & brno + 1

sm = WorksheetFunction.Sum(Range(rg))

avg = WorksheetFunction.Average(Range(rg))

max = WorksheetFunction.max(Range(rg))

min = WorksheetFunction.min(Range(rg))
 Sheets("Summary").Select

Range("I8") = sm

Range("I9") = avg

Range("I10") = max

Range("I11") = min

End Sub

14 For loop demo

Sub for_demo()

Dim sm As Double

sm = 0

For i = 1 To 5

sm = sm + i

Next i

MsgBox sm

End Sub

15 for loop and If using to calculate loan schedule

Sub for_demo()

Range("A6:D1000").ClearContents

Dim rt, per, amt As Double

rt = Range("A1")

per = Range("B1")

amt = Range("C1")

For i = 1 To per

Cells(i + 5, 1) = i

Cells(i + 5, 2) = WorksheetFunction.IPmt(rt / 12, i, per, -amt)

Cells(i + 5, 3) = WorksheetFunction.PPmt(rt / 12, i, per, -amt)

If i = 1 Then

Cells(i + 5, 4) = amt - Cells(i + 5, 3)

Cells(i + 5, 4) = Cells(i + 4, 4) - Cells(i + 5, 3)

End If

Next i

End Sub

16 For loop with step

Sub func()

Dim sm As Double

sm = 0

For i = 1 To 1000 Step 2

num = num + VBA.Sqr(i)

Next i

MsgBox num

End Sub

17 for loop with step -1

Sub func()

j=1

For i = 1000 To 1 Step -1

Cells(j, 1) = i

j=j+1

Next i

End Sub

18 mutiple for loop example

Sub multiple_for()

Dim mon, br As Double

For mon = 2 To 13

For br = 2 To 601

Cells(br, mon) = Cells(br, mon) * 100

Next mon

End Sub

19 goal seek using for loop

Sub goal_seek()

'Range("H3").GoalSeek Goal:=90000, ChangingCell:=Range("F3")

Dim s, tar, chn As String

For i = 3 To 12

s = "H" & i

tar = "I" & i

chn = "F" & i

Range(s).GoalSeek Goal:=Range(tar), ChangingCell:=Range(chn)

Next i

End Sub

20 copy paste example

Sub salary()

For i = 1 To 3

Sheets(i).Select

Range("G2:G51").Copy

Sheets("Final").Select

Cells(2, i + 1).Select

Selection.PasteSpecial Paste:=xlPasteValues

Next i

End Sub

21 Calculating outstanding principal and interest

Sub int_prin()

Dim i, j, paid, tot As Integer

Dim prin, out_prin, out_int As Double

For i = 2 To 11

rt = Cells(i, 1)

tot = Cells(i, 2) * 12

prin = Cells(i, 3)

paid = Cells(i, 9)

out_int = 0

out_prin = 0

For j = paid + 1 To tot

out_int = out_int + WorksheetFunction.IPmt(rt / 12, j, tot, -prin)

out_prin = out_prin + WorksheetFunction.PPmt(rt / 12, j, tot, -prin)

Next j

Cells(i, 7) = out_int

Cells(i, 8) = out_prin

Next i

End Sub

22 Top 5 numbers

Sub ntop()

Sheets(2).Select

Cells.ClearContents

Dim top As Double

Sheets(1).Select

k=2

For i = 2 To 6

For j = 1 To 5

Sheets(1).Select

top = WorksheetFunction.Large(Range(Cells(k, i), Cells(k + 2399, i)), j)

Cells(j, i) = top

Next j

Next i

End Sub

23 Assignment q1

Sub bond_cash_flow()

Sheets(2).Select

Dim rem_co, freq As Integer

Dim num As Double

num = 0

Dim cou As Single

For i = 2 To 11

rem_co = Cells(i, 6)

cou = Cells(i, 2)

freq = Cells(i, 4)

num = ((100 * cou) / freq) * (rem_co - 1)

num = num + 100 + (100 * cou)

Cells(i, 7) = num

Next i

End Sub

24 Assignment q2

Sub loan_cash()

Range("A7:D2000").ClearContents

Dim amt, per, rt, freq, pe As Double

amt = Cells(1, 2)

freq = Cells(3, 4)
 per = Cells(1, 4) * freq

rt = Cells(3, 2)

For i = 7 To per + 6

Cells(i, 1) = i - 6

Cells(i, 2) = WorksheetFunction.IPmt(rt / freq, Cells(i, 1), per, -amt)

Cells(i, 3) = WorksheetFunction.PPmt(rt / freq, Cells(i, 1), per, -amt)

If i = 7 Then

Cells(i, 4) = amt - Cells(i, 3)

Else

Cells(i, 4) = Cells(i - 1, 4) - Cells(i, 3)

End If

Next i

End Sub

25 Assignment q3

Sub goal_seek()

Dim tar, chn As String

Dim amt As Double

For i = 2 To 12

amt = Cells(i, 2)

tar = "D" & i

chn = "B" & i

Range(tar).GoalSeek goal:=10000, ChangingCell:=Range(chn)

Cells(i, 5) = Cells(i, 2)

Cells(i, 2) = amt

Next i

End Subs
26 solver using macro example

Sub solver_demo()

'

' Macro4 Macro

'

'

Application.DisplayAlerts = False

Sheets(1).Select

Dim rg As String

Dim amt As Double

For i = 1 To 5

Sheets(1).Select

rg = "J" & i + 25 & ":O" & i + 25

SolverOk SetCell:="$H$14", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$14:$F$14", _

Engine:=2, EngineDesc:="Simplex LP"

SolverAdd CellRef:="$B$14:$F$14", Relation:=4, FormulaText:="integer"

SolverAdd CellRef:="$H$17:$H$22", Relation:=3, FormulaText:=Range(rg)

SolverOk SetCell:="$H$14", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$14:$F$14", _

Engine:=2, EngineDesc:="Simplex LP"

SolverOk SetCell:="$H$14", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$14:$F$14", _

Engine:=2, EngineDesc:="Simplex LP"

SolverSolve True 'true written to hide the solver box

Range("B14:F14").Copy

amt = Range("H14")

Sheets(2).Select

Cells(i, 1).Select

ActiveSheet.Paste
 Cells(i, 6) = amt

Next i

Application.DisplayAlerts = True

End Sub

27 trades example for nested for loop

Sub trades()

Application.ScreenUpdating = False 'to prevent flickring of screen

Dim sec As String

Dim num As Integer

For i = 2 To 26

Sheets(1).Select

sec = Cells(i, 1)

For j = 2 To 13

Sheets(j).Select

num = WorksheetFunction.IfError(Application.VLookup(sec, Range("B2:N200"), 6, 0), 0)

Sheets(1).Select

Cells(i, j) = num

Next j

Next i

Application.ScreenUpdating = True

End Sub

28 Array example

Sub array_ex()

Dim num(1000) As Integer

Dim sm As Double

For i = 1 To 1000

num(i) = WorksheetFunction.RandBetween(100, 1000)

sm = sm + num(i)

Cells(i, 1) = num(i)
 Next i

'MsgBox sm

End Sub

29 Correlation example with range object

Sub corel()

Dim rg As Range

Sheets(1).Select

Set rg = Range("A2:D570")

rg.Font.Bold = True

Sheets(2).Select

Cells.Clear

For i = 1 To 4

For j = 1 To 4

Cells(i, j) = WorksheetFunction.Correl(rg.Columns(i), rg.Columns(j))

Next j

Next i

End Sub

30 input box example

Sub input_demo()

Dim age As Integer

age = VBA.Val(InputBox("Enter your age"))

MsgBox age

End Sub

31 function example

Function celcius(fr As Single)

celcius = ((fr - 32) / 9) * 5

End Function
Sub demo()

Dim fr As Single

fr = InputBox("Enter the temp in f")

MsgBox celcius(fr) & " Temp in celcius"

End Sub