Dr Nala FinSys Consulting, Training and Academia

Free VBA Macros

1. To get inputs from the user for placing text matter at a particular cell in a wrapped format

2. To get inputs from the user for placing text matter at a particular location as per the input fro

Sub getinpunplace()

Range("a9").Value = InputBox("Enter the information")

Range("a9").Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlBottom

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

End Sub

2. To get inputs from the user for placing text matter at a particular location as per the input fro

Sub getinputnplaceanylocation()

Dim info, location As String

info = InputBox("Enter the information")

If (info <> "") Then

location = InputBox(Prompt:="enter target location")

End If

Range(location).Value = info

End Sub

3. To get inputs from the user, pass the values through a function and place the value at a target s

2. To get inputs from the user for placing text matter at a particular location as per the input fro

3. To get inputs from the user, pass the values through a function and place the value at a target s

Main Procedure

Private Sub CommandButton2_Click()

Dim salesdata, location As String

salesdata = getsalesdata()

If (salesdata <> "") Then

location = InputBox(Prompt:="enter target location")

'Call postinput(salesdata, "b3")

Call postinput(salesdata, location)

End If

End Sub

Function to get the sales value through input box

Function getsalesdata()

getsalesdata = InputBox("Enter sales data")

End Function

Procedure to place the values passed on at the location

Sub postinput (Inputdata, target)

'salesdata and location obtained from sub commandbutton2_click are passed on to this sub as inputdata and target

Range(target).Value = Inputdata

End Sub

4. This macro creates ledger accounts based on user input, creates space based on number of rows req

3. To get inputs from the user, pass the values through a function and place the value at a target s

Private Sub opennewsuppac_Click()

Dim row, cell As Object

Worksheets("crealedaccts").Select

rangename = InputBox("Enter the from row") & ":" & InputBox("Enter the to row")

ActiveWorkbook.Names.Add Name:="rname", RefersToR1C1:=ActiveSheet.Range(rangename)

ActiveWorkbook.ActiveSheet.Range("rname").Select

Selection.EntireRow.Insert

Worksheets("crealedaccts").Range(rangename).Select

ActiveCell.Value = InputBox("Enter the name")

ActiveWorkbook.Names.Add Name:=ActiveCell.Value, RefersToR1C1:=ActiveSheet.Range(rangename)

ActiveCell.Offset(1, 0).Value = "Date"

ActiveCell.Offset(1, 1).Value = "Particulars"

ActiveCell.Offset(1, 2).Value = "JF"

ActiveCell.Offset(1, 3).Value = "Amount"

ActiveCell.Offset(1, 4).Value = "Date"

ActiveCell.Offset(1, 5).Value = "Particulars"

ActiveCell.Offset(1, 6).Value = "JF"

ActiveCell.Offset(1, 7).Value = "Amount"

For Each row In Range(rangename).Rows

numrows = numrows + 1

Next row

MsgBox ("no of rows" & numrows)

ActiveCell.Offset(numrows - 1, 0).Select

ActiveCell.Offset(0, 1).Value = "Total"

'MsgBox (row.Number)

ActiveCell.Offset(0, 3).Select

While ActiveCell.Value <> "Amount"

ActiveCell.Offset(-1, 0).Select

i = i + 1

Wend

ActiveCell.Offset(i, 0).Select

i = -(i - 1)

ActiveCell.FormulaR1C1 = "=SUM(R[" & i & "]C:R[-1]C)"

ActiveCell.Offset(0, 4).FormulaR1C1 = "=SUM(R[" & i & "]C:R[-1]C)"

i = i + 1

ActiveCell.Offset(-1, 0).FormulaR1C1 = "=SUM(R[" & i[DNS1] & "]C:R[-1]C)"

drtot = ActiveCell.Offset(-1, 0).Value

ActiveCell.Offset(-1, 4).FormulaR1C1 = "=SUM(R[" & i & "]C:R[-1]C)"

crtot = ActiveCell.Offset(-1, 4).Value

ActiveCell.Select

ActiveCell.Offset(-1, 0).FormulaR1C1 = _

"=IF(SUM(R[" & i & "]C:R[-1]C)>=SUM(R[" & i & "]C[4]:R[-1]C[4]),0,SUM(R[" & i & "]C[4]:R[-1]C[4])-SUM(R[" & i & "]C:R[-1]C))"

ActiveCell.Offset(-1, 4).FormulaR1C1 = _

"=IF(SUM(R[" & i & "]C:R[-1]C)>=SUM(R[" & i & "]C[-4]:R[-1]C[-4]),0,SUM(R[" & i & "]C[-4]:R[-1]C[-4])-SUM(R[" & i & "]C:R[-1]C))"

ActiveCell.Offset(-1, -2).FormulaR1C1 = "=IF(RC[2]>0,""To Balance c/d"","""")"

ActiveCell.Offset(-1, 2).FormulaR1C1 = "=IF(RC[2]>0,""By Balance c/d"","""")"

End Sub

[DNS1]Note that SPACE which appears before and after "i"

5. Checks whether a transaction has been posted to the ledger based on the entry of ‘LF’ and Flags a

4. This macro creates ledger accounts based on user input, creates space based on number of rows req

5. Checks whether a transaction has been posted to the ledger based on the entry of ‘LF’ and Flags a

Private Sub chkpostatus_Click()

Dim rowcnt As Single

Worksheets("XlnMac").Select

ActiveCell.Select

ActiveCell.Offset(-1, 15).Select

rowcnt = 1

'.Select

While Selection.Value <> "Remarks"

'page = ActiveCell.Offset(0, -2).Value

'If page > 1 Then

'the following code verifies whether LF No is entered

If ActiveCell.Offset(0, -3).Value <> "" Then

ActiveCell.Value = "Posted"

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 5287936

.TintAndShade = 0

.PatternTintAndShade = 0

End With

End If

rowcnt = rowcnt + 1

ActiveCell.Offset(-1, 0).Select

Wend

ActiveCell.Offset(rowcnt, -15).Select

End Sub

6. This macro creates hyperlink within the Workbook

4. This macro creates ledger accounts based on user input, creates space based on number of rows req

5. Checks whether a transaction has been posted to the ledger based on the entry of ‘LF’ and Flags a

Private Sub crealnk_Click()

Workbooks("OutputWbkMay23.xlsm").Activate

Worksheets("ISINbase").Select

ActiveSheet.range("n4:n181").Select

For Each row In ActiveSheet.range("n4:n181").Rows

row.Select

ActiveCell.Offset(0, 0).Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=ActiveCell.Offset(0, 0).Value

Next row

End Sub

FOR MORE INFORMATION, PLEASE REACH US VIA THE MESSENGER LINK AT THE BOTTOM RIGHT OF THIS PAGE WITH A 'COMMENT' SYMBOL

findOutMore6