Skip to main content

Create individual pdf from mail merge

Create individual pdf using mail merge in word from Excel

Copy + Paste below code in word file and Press F5

 

Sub Create_PDF_From_Mail_Merge()
‘This vba code written by Akumar – 99Excel.com

Application.ScreenUpdating = False
Dim DocName As String, PDFPath, Folderpath, From, Till, Message, fs
Folderpath = “C:\99Excel.com – Folder”

Set fs = CreateObject(“Scripting.FileSystemObject”)
If fs.FolderExists(Folderpath) = False Then
fs.createfolder (Folderpath)
Else: End If

From = 1
Till = 5

Message = (Till – From) + 1
While From <= Till

ActiveDocument.MailMerge.DataSource.ActiveRecord = From
DocName = ActiveDocument.Fields(4).Result
PDFPath = Folderpath & “\” & DocName & “.pdf”
Massage = ((Till – From) + 1)

ActiveDocument.ExportAsFixedFormat OutputFileName:=PDFPath, ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True

From = From + 1
Wend

MsgBox (Message & ” Pdf Files Saved In = ” & Folderpath)

End Sub

 

 

Automatic message in excel

Sub Auto_Open()
Msgbox "Welcome to My Excel Sheet"
End Sub

Instructions:
  1. Open an excel workbook
  2. Press Alt+F11 to open VBA Editor
  3. Double click on ThisWorkbook from Project Explorer
  4. Copy the above code and Paste in the code window
  5. Save the file as macro enabled workbook
  6. Open the workbook to test it, it will Run a Macro Automatically. You should see a message box as shown above

know more click here

India Salary tax computation in excel vba

Below we will look at a program in Excel VBA that calculates the tax on an income. The following tax rates apply to individuals who are residents of India.

 

Download the Indian Salary tax computation in excel vba. Tax Computation & CTC Structure 2015-16

 

 

Code in open sheet

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(“Tax Computation & CTC Structure”).Visible = xlSheetVisible
ActiveWorkbook.Sheets(“Welcome”).Visible = xlSheetVeryHidden
Application.Calculation = xlCalculationAutomatic
Sheets(“Tax Computation & CTC Structure”).Select
‘Call My_Vba.Resetall
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 1

End Sub

Private Sub Workbook_Activate()
Application.ScreenUpdating = False
ActiveWorkbook.Protect (“password”)
Application.ScreenUpdating = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect (“password”)
ActiveWorkbook.Sheets(“Welcome”).Visible = xlSheetVisible
ActiveWorkbook.Sheets(“Tax Computation & CTC Structure”).Visible = xlSheetVeryHidden
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Protect (“password”)
ThisWorkbook.Close savechanges:=True
Application.ScreenUpdating = False
End Sub

 


 

following code in work sheet

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells, KeyCells1, KeyCells2, KeyCells3, KeyCells4 As Range

Set KeyCells = Range(“Annual_CTC”)
Set KeyCells1 = Range(“Bonus_Ap”)
Set KeyCells2 = Range(“Basic,Hra,Conv,metronmetro”)
Set KeyCells3 = Range(“Medical,lta,veh,driv,pd”) ‘enta
Set KeyCells4 = Range(“var_paya”)
Set KeyCells5 = Range(“PF_Ap,ESI_Ap,Gratuity_Ap,Bonus_Ap”)
Set KeyCells6 = Range(“Renta”)

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call Missmatch
If Range(“Spl_all”).Value < 0 Then
Range(“lta”).Value = 0
Range(“veh”).Value = 0
Range(“driv”).Value = 0
Else: End If

ElseIf Not Application.Intersect(KeyCells1, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False
If Range(“Bonus_Ap”).Value = “Yes” Then
Range(“bonus_amt”).Formula = “=IF(Annual_CTC>0,IF(SUM(reimb_ff)>0,0,10000),0)”
Else
Range(“bonus_amt”).Value = 0

End If

ElseIf Not Application.Intersect(KeyCells2, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False
Call Missmatch

ElseIf Not Application.Intersect(KeyCells3, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False
Call Missmatch
Range(“lta”).Select

ElseIf Not Application.Intersect(KeyCells4, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False
Call Missmatch
Range(“comp_med”).Select

ElseIf Not Application.Intersect(KeyCells5, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False
Call Missmatch
Range(“PF_Ap”).Select

ElseIf Not Application.Intersect(KeyCells6, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False

If Range(“Renta”).Value > 0 Then

If Range(“Renta”).Value > 8333 Then
MsgBox (“Monthly rent is above Rs. 8333/-, You required to report the PAN of the landlord to the employer at the end of year.”)
Range(“rentlocation”).Value = “Delhi”
Range(“from”).Formula = “=MAX(” & “01/04/2014” & “,Effectivedate)”
Range(“to”).Value = “31/03/2016”
Else: End If
Range(“rentlocation”).Value = “Delhi”
Range(“from”).Formula = “=MAX(” & “01/04/2014” & “,Effectivedate)”
Range(“to”).Value = “31/03/2016”
Range(“Renta”).Select
Else: End If
Else: End If
End Sub


Sub Resetall()
On Error Resume Next
Sheets(“Tax Computation & CTC Structure”).Unprotect Password:=”password”
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range(“Annual_CTC”).Value = “0”

Range(“Basic”).ClearContents
Range(“Basic”).Formula = “=ROUND(Annual_CTC*20%,0)”

Range(“reimb_amt”).Value = “0”
Range(“itamt”).Value = “0”
Range(“var_paya”).Value = “0”

Range(“Conv”).ClearContents
Range(“Conv”).Formula = “=IF(veh>0,0,IF(Annual_CTC>0,19200,0))”

Range(“Medical”).ClearContents
Range(“Medical”).Formula = “=IF(Annual_CTC>0,15000,0)”

Range(“lta”).ClearContents
Range(“lta”).Formula = “=IF(Annual_CTC>0,60000,0)”

Range(“veh”).ClearContents
Range(“veh”).Formula = “=IF(Annual_CTC>0,96000,0)”

Range(“driv”).ClearContents
Range(“driv”).Formula = “=IF(Annual_CTC>0,60000,0)”

Range(“rentlocation”).ClearContents
Range(“from”).ClearContents
Range(“to”).ClearContents

If Range(“Bonus_Ap”).Value = “Yes” Then
Range(“bonus_amt”).Formula = “=IF(Annual_CTC>0,IF(SUM(reimb_ff)>0,0,10000),0)”
Else
Range(“bonus_amt”).Value = 0
End If

Range(“us8c”).Value = “0”
Range(“medis”).Value = “0”
Range(“medps”).Value = “0”
Range(“usE”).Value = “0”
Range(“usU”).Value = “0”
Range(“usdd”).Value = “0”
Range(“usddb”).Value = “0”
Range(“usccd”).Value = “0”

Range(“Renta”).Value = “0”
Range(“ptax”).Value = “0”
Range(“prv_sal”).Value = “0”
Range(“inc_other”).Value = “0”
Range(“Deducted_tax”).Value = “0”

Range(“medbill”).Formula = “=C14”
Range(“medbill”).Select
Selection.Copy
Range(“billsamt”).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range(“medbill”).Select

Range(“Emp_name”).Value = “”
Range(“DSG_name”).Value = “”

On Error Resume Next

Sheets(“Tax Computation & CTC Structure”).Protect Password:=”password”
Application.ScreenUpdating = False
End Sub

Sub Missmatch()
On Error Resume Next
Application.ScreenUpdating = False
Sheets(“Tax Computation & CTC Structure”).Unprotect Password:=”password”
Range(“Spl_all”).Select
Selectionvalue = 0
Range(“diffrence”).Select
Selection.Copy
Range(“Spl_all”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(“Tax Computation & CTC Structure”).Protect Password:=”password”
On Error Resume Next
Application.ScreenUpdating = False
End Sub

Sub PrintSheet()
Application.ScreenUpdating = False
Dim f As Integer, t As Integer, Message, Ans
Application.ScreenUpdating = False

If Range(“Emp_name”).Value = “” Then
Range(“Emp_name”).Select
MsgBox (“Employee Name Shoud not be Blank”)
Exit Sub
End If

If Range(“DSG_name”).Value = “” Then
Range(“DSG_name”).Select
MsgBox (“Employee Designation Shoud not be Blank”)
Exit Sub
End If

If Range(“Annual_CTC”).Value < 1 Then
Range(“Annual_CTC”).Select
MsgBox (“Annual_CTC is not Correct”)
Exit Sub
End If

If Range(“Spl_all”).Value < 1 Then
Range(“Spl_all”).Select
MsgBox (“CTC Structure values are not Correct”)
Exit Sub
End If

Application.ScreenUpdating = False

Ans = MsgBox(“Are you sure want to Print ?”, vbYesNo + vbExclamation, “Confirmation – Yes No”)
If Ans = vbNo Then
Exit Sub
End If
ActiveSheet.PrintOut

Application.ScreenUpdating = False

End Sub


 

 

 

Inner and Outer Loops , Exiting a Loop , Exit Do

Inner and Outer Loops

Any type of Loop can have more than one level. This is very similar to Nesting Worksheet formulas on a Worksheet. There is no limit (except memory) of the level to which you can Nest loops. To keep things simple though we will only look at a two level Loop. Let’s say we want to Loop through all cells in the Range A1:A10 on each Worksheet and place the address of the cell in each cell. To do this we would use:

Exiting a Loop

In all the above Loop examples we have allowed the loop to continue on until the loop condition is met. But there are times when we may wish to force our loop to leave a loop early. This is done by using the Exit Statement. Let’s assume we wish to loop through a range of cells and select a cell if it’s value is 100.

Exit Do

So that is basically all there is to Loops. Used in the context as shown above would not really be of much use, but it is far more important to understand the concept of them than to use them without knowing how they work. The only other part of Loops that you will most likely encounter is what is known as the endless Loop. This occurs when you start a loop that will never meet the condition you have set and so it just keeps going around endlessly. When this happens you need to push Ctrl+Break or Esc.

For Each loop

For Each

This Loop is slightly different from the others, but only in the fact that it requires an Object as the Variable. What it does is simply Loop though each single Object in a Collection of Objects.

 

Sub My_ForEach()

Dim rMyCell As Range

Dim iMyNumber As Integer

For Each rMyCell In Range(“A1:A100”)

iMyNumber = 1 + iMyNumber

rMyCell.Value = iMyNumber

Next rMyCell

End Sub

 

For Each Cell in the Range A1 to Range A100 add 1 to the Variable iMyNumber2 Where “Cell” is represented by the Range Variable “rMyCell” So it will do this 100 times as there are 100 Range Objects in the Object Collection Range(“A1:A100”)

 

We do not need to tell the For Each Loop how many times to Loop as it already knows how many Objects (Cells in this case) there are in the Object Collection (Range(A1:A100)).

 

Our Object Collection does not have to be a Range Collection, it could be a Charts, Worksheets, Workbooks etc Collection. In fact it can be any Collection of Objects. So if we wanted to Loop through all Worksheets in a Workbook we could use:

 

Sub My_ForEach1()

Dim wWsht As Worksheet

For Each wWsht In ThisWorkbook.Worksheets

wWsht.Range(“A1”) = wWsht.Name

    Next wWsht

End Sub

For Loop

 

The For Loop is perhaps the most useful of all the Loops. It runs a line or lines of code a set amount of times in any increment we set. The default increment is one. As you can see from below you must use a Variable of the Numeric type to set the amount of Loops it will perform.

 

 

Sub My_For()

Dim iMyNumber as Integer

 

For iMyNumber= 1 To 100

iMyNumber=1+iMyNumber

Range(“b2”).Value = iMyNumber

Next iMyNumber

 

End Sub

 

 

The other great part about the For Loop is we can increment by any Value we like. We do this by using the Step Key word and telling it the Step (or increment) to use. so we could use:

 

Sub My_For1()

Dim iMyNumber as Integer

Dim iMyNumber2 as Integer

 

For iMyNumber= 1 To 100 Step 2

iMyNumber2 =1+iMyNumber2

Next iMyNumber

 

Range(“b2”).Value = iMyNumber

 

End Sub

By doing this we will Loop through our code 51 times instead of 101 times, but the Variable iMyNumber will end up with a Value of 101.

 

We could also use the Step Key word to work backwards like below:

Sub My_For2()

Dim iMyNumber as Integer

Dim iMyNumber2 as Integer

 

For iMyNumber= 1000 To 1 Step -1

iMyNumber2 =1+iMyNumber2

Next iMyNumber

Range(“b2”).Value = iMyNumber

 

End Sub

 

This would mean that our Variable iMyNumber would end up with a Value of 0 (Zero).

Do Loop Parts

 

Term Definition
Do Required. Starts the definition of the Do loop.
While Required unless Until is used. Repeat the loop until condition is False.
Until Required unless While is used. Repeat the loop until condition is True.
condition Optional. Boolean expression. If condition is Nothing, Visual Basic treats it as False.
statements Optional. One or more statements that are repeated while, or until, condition is True.
Continue Do Optional. Transfers control to the next iteration of the Do loop.
Exit Do Optional. Transfers control out of the Do loop.
Loop Required. Terminates the definition of the Do loop.

Do Until

Again this is very similar to the Do While Loop we just used above in that it will check the condition BEFORE it enters the Loop. If the Value of iMyNumber is 0 (zero) when it reaches the Loop, the difference is the Do While would keep adding the number one to iMyNumber until it reached 1000.

 

In the Do Until it would never even enter the Loop because the condition MyNumber < 1000 has been met already ie; iMyNumber is 0 (zero).

 

 

Sub My_DoUntil()

Dim iMyNumber as Integer

 

Do until iMyNumber < 1000

iMyNumber=1+iMyNumber

    Loop

End Sub

Do While

This is very similar to ours Do Loop we just used above. The only difference is, instead of the condition we set (iMyNumber < 1000) being checked AFTER the Do has run at least once, the Do While will check the condition BEFORE it runs. Let’s say our Variable iMyNumber has already had the Value 101 parsed to it. In the Do Loop we used above, it will NOT know the Value of iMyNumber until it has run ONCE. This would mean our Variable would come out of the Do Loop with a Value of 102. But in the Do While below, it would never even enter the Loop:-

 

 

Sub My_DoWhile()

Dim iMyNumber as Integer

 

Do While iMyNumber < 1000

iMyNumber = 1 + iMyNumber

Range(“b2”).Value = iMyNumber

Loop

End Sub