Top 100 Useful Excel Macro [VBA] Codes Examples

Macro codes can save you a ton of time.

You can automate small as well as heavy tasks with VBA codes.

And do you know?

With the help of macros...

...you can break all the limitations of Excel which you think Excel has.

And today, I have listed some of the useful codes examples to help you become more productive in your day to day work.

You can use these codes even if you haven't used VBA before that.

But here's the first thing to know:

What is a Macro Code?

In Excel, macro code is a programming code which is written in VBA (Visual Basic for Applications) language.

The idea behind using a macro code is to automate an action which you perform manually in Excel, otherwise.

For example, you can use a code to print only a particular range of cells just with a single click instead of selecting the range -> File Tab -> Print -> Print Select -> OK Button.

How to use a Macro Code in Excel

  • Go to your developer tab and click on "Visual Basic" to open the Visual Basic Editor.
    click-on-visual-basic-editor-before-you-use-these-useful-macros-for-excel
  • On the left side in "Project Window", right click on the name of your workbook and insert a new module.
    add-module-to-paste-these-useful-macros-for-excel
  • Just paste your code into the module and close it.
    use-useful-macro-codes-examples-by-pasting-them-into-vb-editor
  • Now, go to your developer tab and click on the macro button.
    useful-macro-codes-examples-to-use-from-macro-options
  • It will show you a window with a list of the macros you have in your file from where you can run a macro from that list.
    useful-macro-codes-examples-list-from-macro-option

List of top 100 macro Examples (CODES) for VBA beginners

I’ve added all the codes into specific categories so you can find your favorite codes quickly. Just read the title and click on it to get the code.

note

Basic Codes

These VBA codes will help you to perform some basic tasks in a flash which you frequently do in your spreadsheets.

1. Add Serial Numbers

Sub AddSerialNumbers()
Dim i As Integer
On Error GoTo Last
i = InputBox("Enter Value", "Enter Serial Numbers")
For i = 1 To i
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Activate
Next i
Last:Exit Sub
End Sub

2. Insert Multiple Columns

Sub InsertMultipleColumns()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireColumn.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert", "Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub

This code helps you to enter multiple columns in a single click. When you run this code it asks you the number columns you want to add and when you click OK, it adds entered number of columns after the selected cell. If you want to add columns before the selected cell, replace the xlToRight to xlToLeft in the code.

3. Insert Multiple Rows

Sub InsertMultipleRows()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireRow.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert", "Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub

4. Auto Fit Columns

Sub AutoFitColumns()
Cells.Select
Cells.EntireColumn.AutoFit
End Sub

5. Auto Fit Rows

Sub AutoFitRows()
Cells.Select
Cells.EntireRow.AutoFit
End Sub

You can use this code to auto-fit all the rows in a worksheet. When you run this code it will select all the cells in your worksheet and instantly auto-fit all the row.

6. Remove Text Wrap

Sub RemoveTextWrap()
Range("A1").WrapText = False
End Sub

This code will help you to remove text wrap from the entire worksheet with a single click. It will first select all the columns and then remove text wrap and auto fit all the rows and columns. There’s also a shortcut that you can use (Alt + H +‌W) for but if you add this code to QAT it’s way more than keyboard shortcut.

7. Unmerge Cells

Sub UnmergeCells()
Selection.UnMerge
End Sub

This code simply uses the unmerge options which you have on the HOME‌ tab. The benefit of using this code is you can add it to the QAT and unmerge all the cell in the selection. And if you want to un-merge a specific range you can define that range in the code by replacing the word selection.

8. Open Calculator

Sub OpenCalculator()
Application.ActivateMicrosoftApp Index:=0
End Sub

In Windows, there is a specific calculator and by using this macro code you can open that calculator directly from Excel. As I mentioned that it’s for windows and if you run this code in the MAC version of VBA you’ll get an error.

9. Add Header/Footer Date

Sub DateInHeader()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&D"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub

This macro adds a date to the header when you run it. It simply uses the tag "&D" for adding the date. You can also change it to the footer or change the side by replacing the "" with the date tag. And if you want to add a specific date instead of the current date you can replace the "&D" tag with that date from the code.

10. Custom Header/Footer

Sub CustomHeader()
Dim myText As String
myText = InputBox("Enter your text here", "Enter Text")
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = myText
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub

When you run this code, it shows an input box that asks you to enter the text which you want to add as a header, and once you enter it click OK.

If you see this closely you have six different lines of code to choose the place for the header or footer. Let’s say if you want to add left-footer instead of center header simply replace the “myText” to that line of the code by replacing the "" from there.

Formatting Codes

These VBA codes will help you to format cells and ranges using some specific criteria and conditions.

11. Highlight Duplicates from Selection

Sub HighlightDuplicateValues()
Dim myRange As Range
Dim myCell As Range
Set myRange = Selection
For Each myCell In myRange
If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 36
End If
Next myCell
End Sub

This macro will check each cell of your selection and highlight the duplicate values.  You can also change the color from the code.

12. Highlight the Active Row and Column

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strRange As String
strRange = Target.Cells.Address & "," & _
Target.Cells.EntireColumn.Address & "," & _
Target.Cells.EntireRow.Address
Range(strRange).Select
End Sub

I really love to use this macro code whenever I have to analyze a data table. Here are the quick steps to apply this code.

  1. Open VBE (ALT + F11).
  2. Go to Project Explorer (Ctrl + R, If hidden).
  3. Select your workbook & double click on the name of a particular worksheet in which you want to activate the macro.
  4. Paste the code into it and select the “BeforeDoubleClick” from event drop down menu.
  5. Close VBE and you are done.

Remember that, by applying this macro you will not able to edit the cell by double click.

13. Highlight Top 10 Values

Sub TopTen()
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).S
tFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 10
.Percent = False
End With
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

Just select a range and run this macro and it will highlight top 10 values with the green color.

14. Highlight Named Ranges

Sub HighlightRanges()
Dim RangeName As Name
Dim HighlightRange As Range
On Error Resume Next
For Each RangeName In ActiveWorkbook.Names
Set HighlightRange = RangeName.RefersToRange
HighlightRange.Interior.ColorIndex = 36
Next RangeName
End Sub

If you are not sure about how many named ranges you have in your worksheet then you can use this code to highlight all of them.

15. Highlight Greater than Values

Sub HighlightGreaterThanValues()
Dim i As Integer
i = InputBox("Enter Greater Than Value", "Enter Value")
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreater, Formula1:=i
Selection.FormatConditions(Selection.FormatConditions.Count).S
tFirstPriority
With Selection.FormatConditions(1)
.Font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(31, 218, 154)
End With
End Sub

Once you run this code it will ask you for the value from which you want to highlight all greater values.

16. Highlight Lower Than Values

Sub HighlightLowerThanValues()
Dim i As Integer
i = InputBox("Enter Lower Than Value", "Enter Value")
Selection.FormatConditions.Delete
Selection.FormatConditions.Add _
Type:=xlCellValue, _
Operator:=xlLower, _
Formula1:=i
Selection.FormatConditions(Selection.FormatConditions.Count).S
tFirstPriority
With Selection.FormatConditions(1)
.Font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(217, 83, 79)
End With
End Sub

Once you run this code it will ask you for the value from which you want to highlight all lower values.

17. Highlight Negative Numbers

Sub highlightNegativeNumbers()
Dim Rng As Range
For Each Rng In Selection
If WorksheetFunction.IsNumber(Rng) Then
If Rng.Value < 0 Then
Rng.Font.Color= -16776961
End If
End If
Next
End Sub

Select a range of cells and run this code. It will check each cell from the range and highlight all cells the where you have a negative number.

18. Highlight Specific Text

Sub highlightValue()
Dim myStr As String
Dim myRg As range
Dim myTxt As String
Dim myCell As range
Dim myChar As String
Dim I As Long
Dim J As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
myTxt = ActiveWindow.RangeSelection.AddressLocal
Else
myTxt = ActiveSheet.UsedRange.AddressLocal
End If
LInput: Set myRg = _
Application.InputBox _
("please select the data range:", "Selection Required", myTxt, , , , , 8)
If myRg Is Nothing Then
Exit Sub
If myRg.Areas.Count > 1 Then
MsgBox "not support multiple columns"
GoTo LInput
End If
If myRg.Columns.Count <> 2 Then
MsgBox "the selected range can only contain two columns "
GoTo LInput
End If
For I = 0 To myRg.Rows.Count - 1
myStr = myRg.range("B1").Offset(I, 0).Value
With myRg.range("A1").Offset(I, 0)
.Font.ColorIndex = 1
For J = 1 To Len(.Text)
Mid(.Text, J, Len(myStr)) = myStrThen
.Characters(J, Len(myStr)).Font.ColorIndex = 3
Next
End With
Next I
End Sub

Suppose you have a large data set and you want to check for a particular value. For this, you can use this code. When you run it, you will get an input box to enter the value to search for.

19. Highlight Cells with Comments

Sub highlightCommentCells()
Selection.SpecialCells(xlCellTypeComments).Select
Selection.Style= "Note"
End Sub

To highlight all the cells with comments use this macro.

20. Highlight Alternate Rows in the Selection

Sub highlightAlternateRows()
Dim rng As Range
For Each rng In Selection.Rows
If rng.Row Mod 2 = 1 Then
rng.Style = "20% -Accent1"
rng.Value = rng ^ (1 / 3)
Else
End If
Next rng
End Sub

By highlighting alternate rows you can make your data easily readable, and for this, you can use below VBA code. It will simply highlight every alternate row in selected range.

21. Highlight Cells with Misspelled Words

Sub HighlightMisspelledCells()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If Not Application.CheckSpelling(word:=rng.Text) Then
rng.Style = "Bad"
End If
Next rng
End Sub

If you find hard to check all the cells for spelling error then this code is for you. It will check each cell from the selection and highlight the cell where is a misspelled word.

22. Highlight Cells With Error in the Entire Worksheet

Sub highlightErrors()
Dim rng As Range
Dim i As Integer
For Each rng In ActiveSheet.UsedRange
If WorksheetFunction.IsError(rng) Then
i = i + 1
rng.Style = "bad"
End If
Next rng
MsgBox _
"There are total " & i _
& " error(s) in this worksheet."
End Sub

To highlight and count all the cells in which you have an error, this code will help you. Just run this code and it will return a message with the number error cells and highlight all the cells.

23. Highlight Cells with a Specific Text in Worksheet

Sub highlightSpecificValues()
Dim rng As range
Dim i As Integer
Dim c As Variant
c = InputBox("Enter Value To Highlight")
For Each rng In ActiveSheet.UsedRange
If rng = c Then
rng.Style = "Note"
i = i + 1
End If
Next rng
MsgBox "There are total " & i & " " & c & " in this worksheet."
End Sub

This code will help you to count the cells which have a specific value which you will mention and after that highlight all those cells.

24. Highlight all the Blank Cells Invisible Space

Sub blankWithSpace()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.Value = " " Then
rng.Style = "Note"
End If
Next rng
End Sub

Sometimes there are some cells which are blank but they have a single space and due to this, it’s really hard to identify them. This code will check all the cell in the worksheet and highlight all the cells which have a single space.

25. Highlight Max Value In The Range

Sub highlightMaxValue()
Dim rng As Range
For Each rng In Selection
If rng = WorksheetFunction.Max(Selection) Then
rng.Style = "Good"
End If
Next rng
End Sub

It will check all the selected cells and highlight the cell with the maximum value.

26. Highlight Min Value In The Range

Sub Highlight_Min_Value()

Dim rng As Range

For Each rng In Selection
	If rng = WorksheetFunction.Min(Selection) Then
		rng.Style = "Good"
	End If
Next rng

End Sub

It will check all the selected cells and highlight the cell with the Minimum value.

27. Highlight Unique Values

Sub highlightUniqueValues()
Dim rng As Range
Set rng = Selection
rng.FormatConditions.Delete
Dim uv As UniqueValues
Set uv = rng.FormatConditions.AddUniqueValues
uv.DupeUnique = xlUnique
uv.Interior.Color = vbGreen
End Sub

This codes will highlight all the cells from the selection which has a unique value.

28. Highlight Difference in Columns

Sub columnDifference()
Range("H7:H8,I7:I8").Select
Selection.ColumnDifferences(ActiveCell).Select
Selection.Style= "Bad"
End Sub

Using this code you can highlight the difference between two columns (corresponding cells).

29. Highlight Difference in Rows

Sub rowDifference()
Range("H7:H8,I7:I8").Select
Selection.RowDifferences(ActiveCell).Select
Selection.Style= "Bad"
End Sub

And by using this code you can highlight difference between two row (corresponding cells).

Printing Codes

These macro codes will help you to automate some printing tasks which can further save you a ton of time. 

30. Print Comments

Sub printComments()
With ActiveSheet.PageSetup
.printComments = xlPrintSheetEnd
End With
End Sub

Use this macro to activate settings to print cell comments in the end of the page. Let’s say you have 10 pages to print, after using this code you will get all the comments on 11th last page.

31. Print Narrow Margin

Sub printNarrowMargin()
With ActiveSheet.PageSetup
.LeftMargin = Application
.InchesToPoints (0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
End With
ActiveWindow.SelectedSheets.PrintOut _
Copies:=1, _
Collate:=True, _
IgnorePrintAreas:=False
End Sub

Use this VBA code to take a print with a narrow margin. When you run this macro it will automatically change margins to narrow.

32. Print Selection

Sub printSelection()
Selection.PrintOut Copies:=1, Collate:=True
End Sub

This code will help you print selected range. You don't need to go to printing options and set printing range. Just select a range and run this code.

33. Print Custom Pages

Sub printCustomSelection()
Dim startpage As Integer
Dim endpage As Integer
startpage = _
InputBox("Please Enter Start Page number.", "Enter Value")
If Not WorksheetFunction.IsNumber(startpage) Then
MsgBox _
"Invalid Start Page number. Please try again.", "Error"
Exit Sub
End If
endpage = _
InputBox("Please Enter End Page number.", "Enter Value")
If Not WorksheetFunction.IsNumber(endpage) Then
MsgBox _
"Invalid End Page number. Please try again.", "Error"
Exit Sub
End If
Selection.PrintOut From:=startpage, _
To:=endpage, Copies:=1, Collate:=True
End Sub

Instead of using the setting from print options you can use this code to print custom page range. Let’s say you want to print pages from 5 to 10. You just need to run this VBA code and enter start page and end page.

Worksheet Codes

These macro codes will help you to control and manage worksheets in an easy way and save your a lot of time.

34. Hide all but the Active Worksheet

Sub HideWorksheet()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub

Now, let's say if you want to hide all the worksheets in your workbook other than the active worksheet. This macro code will do this for you.

35. Unhide all Hidden Worksheets

Sub UnhideAllWorksheet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End Sub

And if you want to un-hide all the worksheets which you have hide with previous code, here is the code for that.

36. Delete all but the Active Worksheet

Sub DeleteWorksheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.name <> ThisWorkbook.ActiveSheet.name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub

If you want to delete all the worksheets other than the active sheet, this macro is useful for you. When you run this macro it will compare the name of the active worksheet with other worksheets and then delete them.

37. Protect all Worksheets Instantly

Sub ProtectAllWorskeets()
Dim ws As Worksheet
Dim ps As String
ps = InputBox("Enter a Password.", vbOKCancel)
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=ps
Next ws
End Sub

If you want to protect your all worksheets in one go here is a code for you. When you run this macro, you will get an input box to enter a password. Once you enter your password, click OK. And make sure to take care about CAPS.

38. Resize All Charts in a Worksheet

Sub Resize_Charts()
Dim i As Integer
For i = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(i)
.Width = 300
.Height = 200
End With
Next i
End Sub

Make all chart same in size. This macro code will help you to make all the charts of the same size. You can change the height and width of charts by changing it in macro code.

39. Insert Multiple Worksheets

Sub InsertMultipleSheets()
Dim i As Integer
i = _
InputBox("Enter number of sheets to insert.", _
"Enter Multiple Sheets")
Sheets.Add After:=ActiveSheet, Count:=i
End Sub

You can use this code if you want to add multiple worksheets in your workbook in a single shot. When you run this macro code you will get an input box to enter the total number of sheets you want to enter.

40. Protect Worksheet

Sub ProtectWS()
ActiveSheet.Protect "mypassword", True, True
End Sub

If you want to protect your worksheet you can use this macro code. All you have to do just mention your password in the code.

41. Un-Protect Worksheet

Sub UnprotectWS()
ActiveSheet.Unprotect "mypassword"
End Sub

If you want to unprotect your worksheet you can use this macro code. All you have to do just mention your password which you have used while protecting your worksheet.

42. Sort Worksheets

Sub SortWorksheets()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub

This code will help you to sort worksheets in your workbook according to their name.

43. Protect all the Cells With Formulas

Sub lockCellsWithFormulas()
With ActiveSheet
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Protect AllowDeletingRows:=True
End With
End Sub

To protect cell with formula with a single click you can use this code.

44. Delete all Blank Worksheets

Sub deleteBlankWorksheets()
Dim Ws As Worksheet
On Error Resume Next
Application.ScreenUpdating= False
Application.DisplayAlerts= False
For Each Ws In Application.Worksheets
If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
Ws.Delete
End If
Next
Application.ScreenUpdating= True
Application.DisplayAlerts= True
End Sub

Run this code and it will check all the worksheets in the active workbook and delete if a worksheet is blank.

45. Unhide all Rows and Columns

Sub UnhideRowsColumns()
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
End Sub

Instead of unhiding rows and columns on by one manually you can use this code to do this in a single go.

46. Save Each Worksheet as a Single PDF

Sub SaveWorkshetAsPDF()
Dimws As Worksheet
For Each ws In Worksheets
ws.ExportAsFixedFormat _
xlTypePDF, _
"ENTER-FOLDER-NAME-HERE" & _
ws.Name & ".pdf"
Next ws
End Sub

This code will simply save all the worksheets in a separate PDF file. You just need to change the folder name from the code.

47. Disable Page Breaks

Sub DisablePageBreaks()
Dim wb As Workbook
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wb In Application.Workbooks
For Each Sht In wb.Worksheets
Sht.DisplayPageBreaks = False
Next Sht
Next wb
Application.ScreenUpdating = True
End Sub

To disable page breaks use this code. It will simply disable page breaks from all the open workbooks.

Workbook Codes

These codes will help you to perform workbook level tasks in an easy way and with minimum efforts. 

48. Create a Backup of a Current Workbook

Sub FileBackUp()
ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _
"" & Format(Date, "mm-dd-yy") & " " & _
ThisWorkbook.name
End Sub

This is one of the most useful macros which can help you to save a backup file of your current workbook. It will save a backup file in the same directory where your current file is saved and it will also add the current date with the name of the file.

49. Close all Workbooks at Once

Sub CloseAllWorkbooks()
Dim wbs As Workbook
For Each wbs In Workbooks
wbs.Close SaveChanges:=True
Next wb
End Sub

Use this macro code to close all open workbooks. This macro code will first check all the workbooks one by one and close them. If any of the worksheets is not saved, you'll get a message to save it.

50. Copy Active Worksheet into a New Workbook

Sub CopyWorksheetToNewWorkbook()
ThisWorkbook.ActiveSheet.Copy _
Before:=Workbooks.Add.Worksheets(1)
End Sub

Let's say if you want to copy your active worksheet in a new workbook, just run this macro code and it will do the same for you. It's a super time saver.

51. Active Workbook in an Email

Sub Send_Mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "Sales@FrontLinePaper.com"
.Subject = "Growth Report"
.Body = "Hello Team, Please find attached Growth Report."
.Attachments.Add ActiveWorkbook.FullName
.display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Use this macro code to quickly send your active workbook in an e-mail. You can change the subject, email, and body text in code and if you want to send this mail directly, use ".Send" instead of ".Display".

52. Add Workbook to a Mail Attachment

Sub OpenWorkbookAsAttachment()
Application.Dialogs(xlDialogSendMail).Show
End Sub

Once you run this macro it will open your default mail client and attached active workbook with it as an attachment.

53. Welcome Message

Sub auto_open()
MsgBox _
"Welcome To ExcelChamps & Thanks for downloading this file."
End Sub

You can use auto_open to perform a task on opening a file and all you have to do just name your macro "auto_open".

54. Closing Message

Sub auto_close()
MsgBox "Bye Bye! Don't forget to check other cool stuff on
excelchamps.com"
End Sub

You can use close_open to perform a task on opening a file and all you have to do just name your macro "close_open".

55. Count Open Unsaved Workbooks

Sub VisibleWorkbooks()
Dim book As Workbook
Dim i As Integer
For Each book In Workbooks
If book.Saved = False Then
i = i + 1
End If
Next book
MsgBox i
End Sub

Let’s you have 5-10 open workbooks, you can use this code to get the number of workbooks which are not saved yet.

Pivot Table Codes

These codes will help you to manage and make some changes in pivot tables in a flash.

56. Hide Pivot Table Subtotals

Sub HideSubtotals()
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
If pt Is Nothing Then
MsgBox "You must place your cursor inside of a PivotTable."
Exit Sub
End If
For Each pf In pt.PivotFields
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
End Sub

If you want to hide all the subtotals, just run this code. First of all, make sure to select a cell from your pivot table and then run this macro.

57. Refresh All Pivot Tables

Sub vba_referesh_all_pivots()
Dim pt As PivotTable
For Each pt In ActiveWorkbook.PivotTables
pt.RefreshTable
Next pt
End Sub

A super quick method to refresh all pivot tables. Just run this code and all of your pivot tables in your workbook will be refresh in a single shot.

58. Create a Pivot Table

Follow this step by step guide to create a pivot table using VBA.

59. Auto Update Pivot Table Range

Sub UpdatePivotTableRange()
Dim Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim lastRow As Long
'Set Pivot Table & Source Worksheet
Set Data_Sheet = ThisWorkbook.Worksheets("PivotTableData3")
Set Pivot_Sheet = ThisWorkbook.Worksheets("Pivot3")
'Enter in Pivot Table Name
PivotName = "PivotTable2"
'Defining Staring Point & Dynamic Range
Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)
'Change Pivot Table Data Source Range Address
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
'Ensure Pivot Table is Refreshed
Pivot_Sheet.PivotTables(PivotName).RefreshTable
'Complete Message
Pivot_Sheet.Activate
MsgBox "Your Pivot Table is now updated."
End Sub

If you are not using Excel tables then you can use this code to update pivot table range.

60. Disable/Enable Get Pivot Data

Sub activateGetPivotData()
Application.GenerateGetPivotData = True
End Sub
Sub deactivateGetPivotData()
Application.GenerateGetPivotData = False
End Sub

To disable/enable GetPivotData function you need to use Excel option. But with this code you can do it in a single click.

Charts Codes

Use these VBA codes to manage charts in Excel and save your lot of time. 

61. Change Chart Type

Sub ChangeChartType()
ActiveChart.ChartType = xlColumnClustered
End Sub

This code will help you to convert chart type without using chart options from the tab. All you have to do just specify to which type you want to convert.

Below code will convert selected chart to a clustered column chart. There are different codes for different types, you can find all those types from here.

62. Paste Chart as an Image

Sub ConvertChartToPicture()
ActiveChart.ChartArea.Copy
ActiveSheet.Range("A1").Select
ActiveSheet.Pictures.Paste.Select
End Sub

This code will help you to convert your chart into an image. You just need to select your chart and run this code.

63. Add Chart Title

Sub AddChartTitle()
Dim i As Variant
i = InputBox("Please enter your chart title", "Chart Title")
On Error GoTo Last
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = i
Last:
Exit Sub
End Sub

First of all, you need to select your chart and the run this code. You will get an input box to enter chart title.

Advanced Codes

Some of the codes which you can use to preform advanced task in your spreadsheets.

64. Save Selected Range as a PDF

Sub HideSubtotals()
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.name)
If pt Is Nothing Then
MsgBox "You must place your cursor inside of a PivotTable."
Exit Sub
End If
For Each pf In pt.PivotFields
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
End Sub

If you want to hide all the subtotals, just run this code. First of all, make sure to select a cell from your pivot table and then run this macro.

65. Create a Table of Content

Sub TableofContent()
Dim i As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Table of Content").Delete
Application.DisplayAlerts = True
On Error GoTo 0
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "Table of Content"
For i = 1 To Sheets.Count
With ActiveSheet
.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(i, 1), _
Address:="", _
SubAddress:="'" & Sheets(i).Name & "'!A1", _
ScreenTip:=Sheets(i).Name, _
TextToDisplay:=Sheets(i).Name
End With
Next i
End Sub

Let's say you have more than 100 worksheets in your workbook and it's hard to navigate now. Don't worry this macro code will rescue everything. When you run this code it will create a new worksheet and create a index of worksheets with a hyperlink to them.

66. Convert Range into an Image

Sub PasteAsPicture()
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Pictures.Paste.Select
End Sub

Paste selected range as an image. You just have to select the range and once you run this code it will automatically insert a picture for that range.

67. Insert a Linked Picture

Sub LinkedPicture()
Selection.Copy
ActiveSheet.Pictures.Paste(Link:=True).Select
End Sub

This VBA code will convert your selected range into a linked picture and you can use that image anywhere you want.

68. Use Text to Speech

Sub Speak()
Selection.Speak
End Sub

Just select a range and run this code. Excel will speak all the text what you have in that range, cell by cell.

69. Activate Data Entry Form

Sub DataForm()
ActiveSheet.ShowDataForm
End Sub

There is a default data entry form which you can use for data entry.

70. Use Goal Seek

Sub GoalSeekVBA()
Dim Target As Long
On Error GoTo Errorhandler
Target = InputBox("Enter the required value", "Enter Value")
Worksheets("Goal_Seek").Activate
With ActiveSheet.Range("C7")
.GoalSeek_ Goal:=Target, _
ChangingCell:=Range("C2")
End With
Exit Sub
Errorhandler: MsgBox ("Sorry, value is not valid.")
End Sub

Goal Seek can be super helpful for you to solve complex problems. Learn more about goal seek from here before you use this code.

71. VBA Code to Search on Google

Sub SearchWindow32()
Dim chromePath As String
Dim search_string As String
Dim query As String
query = InputBox("Enter here your search here", "Google Search")
search_string = query
search_string = Replace(search_string, " ", "+")
'Uncomment the following line for Windows 64 versions and comment out Windows 32 versions'
'chromePath = "C:Program FilesGoogleChromeApplicationchrome.exe"
'Uncomment the following line for Windows 32 versions and comment out Windows 64 versions
'chromePath = "C:Program Files (x86)GoogleChromeApplicationchrome.exe"
Shell (chromePath & " -url http://google.com/#q=" & search_string)
End Sub

Follow this post to learn how to use this VBA code to search on Google.

Formula Codes

These codes will help you to calculate or get results which often you do with worksheet functions and formulas.

72. Convert all Formulas into Values

Sub convertToValues()
Dim MyRange As Range
Dim MyCell As Range
Select Case _
MsgBox("You Can't Undo This Action. " _
& "Save Workbook First?", vbYesNoCancel, _
"Alert")
Case Is = vbYes
ThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
Set MyRange = Selection
For Each MyCell In MyRange
If MyCell.HasFormula Then
MyCell.Formula = MyCell.Value
End If
Next MyCell
End Sub

Simply convert formulas into values. When you run this macro it will quickly change the formulas into absolute values.

73. Remove Spaces from Selected Cells

Sub RemoveSpaces()
Dim myRange As Range
Dim myCell As Range
Select Case MsgBox("You Can't Undo This Action. " _
& "Save Workbook First?", _
vbYesNoCancel, "Alert")
Case Is = vbYesThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
Set myRange = Selection
For Each myCell In myRange
If Not IsEmpty(myCell) Then
myCell = Trim(myCell)
End If
Next myCell
End Sub

One of the most useful macros from this list. It will check your selection and then remove all the extra spaces from that.

74. Remove Characters from a String

Public Function removeFirstC(rng As String, cnt As Long)
removeFirstC = Right(rng, Len(rng) - cnt)
End Function

Simply remove characters from the starting of a text string. All you need is to refer to a cell or insert a text into the function and number of characters to remove from the text string.

It has two arguments "rng" for the text string and "cnt" for the count of characters to remove. For Example: If you want to remove first characters from a cell, you need to enter 1 in cnt.

75. Add Insert Degree Symbol in Excel

Sub degreeSymbol( )
Dim rng As Range
For Each rng In Selection
rng.Select
If ActiveCell <> "" Then
If IsNumeric(ActiveCell.Value) Then
ActiveCell.Value = ActiveCell.Value & "°"
End If
End If
Next
End Sub

Let’s say you have a list of numbers in a column and you want to add degree symbol with all of them.

76. Reverse Text

Public Function rvrse(ByVal cell As Range) As String
rvrse = VBA.strReverse(cell.Value)
End Function

All you have to do just enter "rvrse" function in a cell and refer to the cell in which you have text which you want to reverse.

77. Activate R1C1 Reference Style

Sub ActivateR1C1()
If Application.ReferenceStyle = xlA1 Then
Application.ReferenceStyle = xlR1C1
Else
Application.ReferenceStyle = xlR1C1
End If
End Sub

This macro code will help you to activate R1C1 reference style without using Excel options.

78. Activate A1 Reference Style

Sub ActivateA1()
If Application.ReferenceStyle = xlR1C1 Then
Application.ReferenceStyle = xlA1
Else
Application.ReferenceStyle = xlA1
End If
End Sub

This macro code will help you to activate A1 reference style without using Excel options.

79. Insert Time Range

Sub TimeStamp()
Dim i As Integer
For i = 1 To 24
ActiveCell.FormulaR1C1 = i & ":00"
ActiveCell.NumberFormat = "[$-409]h:mm AM/PM;@"
ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
Next i
End Sub

With this code, you can insert a time range in sequence from 00:00 to 23:00.

80. Convert Date into Day

Sub date2day()
Dim tempCell As Range
Selection.Value = Selection.Value
For Each tempCell In Selection
If IsDate(tempCell) = True Then
With tempCell
.Value = Day(tempCell)
.NumberFormat = "0"
End With
End If
Next tempCell
End Sub

If you have dates in your worksheet and you want to convert all those dates into days then this code is for you. Simply select the range of cells and run this macro.

81. Convert Date into Year

Sub date2year()
Dim tempCell As Range
Selection.Value = Selection.Value
For Each tempCell In Selection
If IsDate(tempCell) = True Then
With tempCell
.Value = Year(tempCell)
.NumberFormat = "0"
End With
End If
Next tempCell
End Sub

This code will convert dates into years.

82. Remove Time from Date

Sub removeTime()
Dim Rng As Range
For Each Rng In Selection
If IsDate(Rng) = True Then
Rng.Value = VBA.Int(Rng.Value)
End If
Next
Selection.NumberFormat = "dd-mmm-yy"
End Sub

If you have time with the date and you want to remove it then you can use this code.

83. Remove Date from Date and Time

Sub removeDate()
Dim Rng As Range
For Each Rng In Selection
If IsDate(Rng) = True Then
Rng.Value = Rng.Value - VBA.Fix(Rng.Value)
End If
NextSelection.NumberFormat = "hh:mm:ss am/pm"
End Sub

It will return only time from a date and time value.

84. Convert to Upper Case

Sub convertUpperCase()
Dim Rng As Range
For Each Rng In Selection
If Application.WorksheetFunction.IsText(Rng) Then
Rng.Value = UCase(Rng)
End If
Next
End Sub

Select the cells and run this code. It will check each and every cell of selected range and then convert it into upper case text.

85. Convert to Lower Case

Sub convertLowerCase()
Dim Rng As Range
For Each Rng In Selection
If Application.WorksheetFunction.IsText(Rng) Then
Rng.Value= LCase(Rng)
End If
Next
End Sub

This code will help you to convert selected text into lower case text. Just select a range of cells where you have text and run this code. If a cell has a number or any value other than text that value will remain same.

86. Convert to Proper Case

Sub convertProperCase()
Dim Rng As Range
For Each Rng In Selection
If WorksheetFunction.IsText(Rng) Then
Rng.Value = WorksheetFunction.Proper(Rng.Value)
End If
Next
End Sub

And this code will convert selected text into the proper case where you have the first letter in capital and rest in small.

87. Convert to Sentence Case

Sub convertTextCase()
Dim Rng As Range
For Each Rng In Selection
If WorksheetFunction.IsText(Rng) Then
Rng.Value = UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) - 1))
End If
Next Rng
End Sub

In text case, you have the first letter of the first word in capital and rest all in words in small for a single sentence and this code will help you convert normal text into sentence case.

88. Remove a Character from Selection

Sub removeChar()
Dim Rng As Range
Dim rc As String
rc = InputBox("Character(s) to Replace", "Enter Value")
For Each Rng In Selection
Selection.Replace What:=rc, Replacement:=""
Next
End Sub

To remove a particular character from a selected cell you can use this code. It will show you an input box to enter the character you want to remove.

89. Word Count from Entire Worksheet

Sub Word_Count_Worksheet()
Dim WordCnt As Long
Dim rng As Range
Dim S As String
Dim N As Long
For Each rng In ActiveSheet.UsedRange.Cells
S = Application.WorksheetFunction.Trim(rng.Text)
N = 0
If S <> vbNullString Then
N = Len(S) - Len(Replace(S, " ", "")) + 1
End If
WordCnt = WordCnt + N
Next rng
MsgBox "There are total " _
& Format(WordCnt, "#,##0") & _
" words in the active worksheet"
End Sub

It can help you to count all the words from a worksheet.

90. Remove the Apostrophe from a Number

Sub removeApostrophes()
Selection.Value = Selection.Value
End Sub

If you have numeric data where you have an apostrophe before each number, you run this code to remove it.

91. Remove Decimals from Numbers

Sub removeDecimals()
Dim lnumber As Double
Dim lResult As Long
Dim rng As Range
For Each rng In Selection
rng.Value = Int(rng)
rng.NumberFormat = "0"
Next rng
End Sub

This code will simply help you to remove all the decimals from the numbers from the selected range.

92. Multiply all the Values by a Number

Sub addNumber()
Dim rng As Range
Dim i As Integer
i = InputBox("Enter number to multiple", "Input Required")
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = rng + i
Else
End If
Next rng
End Sub

Let’s you have a list of numbers and you want to multiply all the number with a particular. To use this code: Select that range of cells and run this code. It will first ask you for the number with whom you want to multiple and then instantly multiply all the numbers with it.

93. Add a Number in all the Numbers

Sub addNumber()
Dim rng As Range
Dim i As Integer
i = InputBox("Enter number to multiple", "Input Required")
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = rng + i
Else
End If
Next rng
End Sub

Just like multiplying you can also add a number into a set of numbers.

94. Calculate the Square Root

Sub getSquareRoot()
Dim rng As Range
Dim i As Integer
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = Sqr(rng)
Else
End If
Next rng
End Sub

To calculate square root without applying a formula you can use this code. It will simply check all the selected cells and convert numbers to their square root.

95. Calculate the Cube Root

Sub getCubeRoot()
Dim rng As Range
Dimi As Integer
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = rng ^ (1 / 3)
Else
End If
Nextrng
End Sub

To calculate cube root without applying a formula you can use this code. It will simply check all the selected cells and convert numbers to their cube root.

96. Add A-Z Alphabets in a Range

Sub addsAlphabets1()
Dim i As Integer
For i = 65 To 90
ActiveCell.Value = Chr(i)
ActiveCell.Offset(1, 0).Select
Next i
End Sub
Sub addsAlphabets2()
Dim i As Integer
For i = 97 To 122
ActiveCell.Value = Chr(i)
ActiveCell.Offset(1, 0).Select
Next i
End Sub

Just like serial numbers you can also insert alphabets in your worksheet. Beloware the code which you can use.

97. Convert Roman Numbers into Arabic Numbers

Sub convertToNumbers()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
If Not WorksheetFunction.IsNonText(rng) Then
rng.Value = WorksheetFunction.Arabic(rng)
End If
Next rng
End Sub

Sometimes it’s really hard to understand Roman numbers as serial numbers. This code will help you to convert roman numbers into Arabic numbers.

98. Remove Negative Signs

Sub removeNegativeSign()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = Abs(rng)
End If
Next rng

This code will simply check all the cell in the selection and convert all the negative numbers into positive. Just select a range and run this code.

99. Replace Blank Cells with Zeros

Sub replaceBlankWithZero()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
If rng = "" Or rng = " " Then
rng.Value = "0"
Else
End If
Next rng
End Sub

For data where you have blank cells, you can use the below code to add zeros in all those cells. It makes easier to use those cells in further calculations.

More VBA Examples

  • VBA Font
  • VBA Line Break
  • VBA Comment
  • VBA New Line
  • VBA Add Borders
  • VBA Check If a Sheet Exists
  • VBA Clear Sheet
  • VBA Count Sheets
  • VBA User Defined Function
  • VBA Delete Sheet
  • VBA Find Last Row, Column, and Cell
  • VBA Hide and Unhide
  • VBA Insert Row
  • VBA Loop Through All the Sheets
  • VBA Merge Cells
  • VBA Protect and Unprotect Sheet
  • VBA Record Macro
  • VBA Rename Sheet
  • VBA Run a Macro
  • VBA Select a Range
  • VBA Select All
  • VBA Range Variable
  • VBA Active Cell
  • VBA Option Explicit
  • VBA SpecialCell Method
  • VBA Used Range
  • VBA New Sheet
  • VBA Functions
  • VBA Array
  • VBA Add New Value to the Array
  • VBA Array Length (Size)
  • VBA Array with Strings
  • VBA Clear Array (Erase)
  • VBA Dynamic Array
  • VBA Sort Array
  • VBA Loop Through an Array
  • VBA Multi-Dimensional Array
  • VBA Range to an Array
  • VBA Search for a Value in an Array
  • VBA AutoFit
  • VBA Automation Error (Error 440)
  • VBA Check IF a Cell is Empty + Multiple Cells
  • VBA Check IF a Workbook Exists in a Folder (Excel File)
  • VBA Check IF a Workbook is Open (Excel File)
  • VBA ClearContents (from a Cell, Range, or Entire Worksheet)
  • VBA Close Workbook (Excel File)
  • VBA Combine Workbooks (Excel Files)
  • VBA Concatenate
  • VBA Copy Range to Another Sheet + Workbook
  • VBA Create and Write to a Text File
  • VBA Create New Workbook
  • VBA Data Types – Variables and Constants
  • VBA Delete Workbook
  • VBA Dim Statement
  • VBA Enter Value in a Cell
  • VBA Error 400
  • VBA Error Handling
  • VBA Exit IF
  • VBA Exit Sub Statement
  • VBA IF – IF Then Else Statement
  • VBA IF And
  • VBA IF Not
  • VBA IF OR
  • VBA Immediate Window
  • VBA Insert Column
  • VBA Invalid Procedure Call Or Argument Error (Error 5)
  • VBA Module
  • VBA MsgBox
  • VBA Named Range
  • VBA Nested IF
  • VBA Object Doesn’t Support this Property or Method Error (Error 438)
  • VBA Object Required Error (Error 424)
  • VBA Objects
  • VBA Range
  • VBA Workbook
  • VBA Worksheet
  • VBA Open Workbook (Excel File)
  • VBA Out of Memory Error (Error 7)
  • VBA Overflow Error (Error 6)
  • VBA Protect/Unprotect Workbook (Excel File)
  • VBA Random Number
  • VBA Range Offset
  • VBA Rename Workbook (Excel File)
  • VBA Rows Count
  • VBA Runtime Error (Error 1004)
  • VBA Save Workbook (Excel File)
  • VBA Screen Updating
  • VBA Select Case
  • VBA Sort Range
  • VBA Status Bar
  • VBA Subscript Out of Range Runtime Error (Error 9)
  • VBA ThisWorkbook (Current Excel File)
  • VBA Type Mismatch Error (Error 13)
  • VBA Wait and Sleep Commands to Pause and Delay
  • VBA With Statement (With – End With)
  • VBA Worksheet Function (Use Excel Functions in a Macro)
  • VBA Wrap Text (Cell, Range, and Entire Worksheet)
  • VBA Copy or Move Sheet
  • About the Author

    puneet one point one

    Puneet is using Excel since his college days. He helped thousands of people to understand the power of the spreadsheets and learn Microsoft Excel. You can find him online, tweeting about Excel, on a running track, or sometimes hiking up a mountain.

     

    182 thoughts

    Leave a Comment

    Your email address will not be published.

    1. Hi Need help on one macro setup to move files from one folder to another
      Conditions:
      1. I have a excel containing list of names for some files that are kept in “master” folder(column A)
      2. The source path in given in Column B for each file name.
      3. Similarly the destination path in given in Column C for each file name.
      4. From each row of the list, the macro will pull the name, the Source path and the destination path and will move that file.
      5. All .xlsx, .pdf and .csv files are in “master” folder some of which are to be transferred to “Mr. A”, “Mr. B” and “Mr. C” folders according to name
      6. there are 3 files with same name and with extension .xlsx, .pdf and .csv respectively.

      Please help.

      Reply
    2. Hello Puneet, thanks for those macros, Im looking for one that converts the clipboard contents into 4 lines of the same data copied, however, each line is restricted to 50 characters, any data exceeds or overflow will carry over to the next line below to continue.
      So assuming I copy a paragraph from another source and wants to paste it into Excel
      Then I want to have it reformat to fit 50 characters per line.

      Reply
    3. is there a way, when i open the excell-file with multiple pages that the cursor is going directly to de cell with de active date?

      Thanx.

      Reply
      • Private Sub Worksheet_Activate()
        Dim FindString As Date
        Dim Rng As Range
        FindString = CLng(Date)
        With Rows(“3:3”)
        Set Rng = .Find(What:=FindString, _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlFormulas, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        If Not Rng Is Nothing Then
        Application.Goto Rng, True
        Else

        ‘Give a message that todays date was not found

        MsgBox “Nothing found”
        End If
        End With
        Module1.Macro1
        End Sub

        Reply
    4. I want to convert Numbers to Indian Rupees and convert it into words.
      For example:
      1.00 = Rupees One and Zero Pise
      10.61 = Rupees Ten and Sixty-One Paise
      132,61,21,326.31 = Rupees One Hundred Thirty-Two Crore Sixty-One Lakhs Twenty-One Thousand Three Hundred and Twenty-Six and Thirty-One Paise
      13,62,74,82,000.21 = Rupees One Thousand Three Hundred Sixty-Two Crores Seventy-Four Lakhs Eighty-Two Thousand and Twenty One Pise

      Reply
    5. If cell value (D12:D69)=”” in sheet12

      Then
      1 click hide entire row hide
      2 click print preview

      After close file die(DE:D69) unhide
      Row

      Vba code

      If possible

      This

      Reply
    6. Is there a way to send the current excel sheet or file as an attachment?
      When I click that hyperlink I want the file to be sent as an attachment to that address.

      Reply
    7. 065 Table of Contents – variation. Add images of the first few rows of each sheet beside the hyperlinks. I’ve not error proofed it yet but you can get the idea…

      ’65. Create a Table of Content
      Sub TableofContent()
      Dim i As Long
      Dim myShape As Object
      Dim Rng As Range
      On Error Resume Next
      Application.DisplayAlerts = False
      Worksheets(“Table of Content”).Delete
      Application.DisplayAlerts = True
      On Error GoTo MyError
      ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
      ActiveSheet.Name = “Table of Content”
      Columns(“A”).ColumnWidth = 40
      Columns(“B”).ColumnWidth = 140
      Columns(“A:A”).VerticalAlignment = xlTop
      For i = 1 To Sheets.Count
      With ActiveSheet
      .Hyperlinks.Add _
      Anchor:=ActiveSheet.Cells(i, 1), _
      Address:=””, _
      SubAddress:=”‘” & Sheets(i).Name & “‘!A1”, _
      ScreenTip:=Sheets(i).Name, _
      TextToDisplay:=Sheets(i).Name
      End With
      Sheets(i + 1).Range(“A1:z7”).Copy
      Rows(i + 1).RowHeight = 60
      ‘Cells(“A” & i).VerticalAlignment = xlVAlignCenter
      Range(“B” & i + 1).Select
      Set Rng = Selection
      ActiveSheet.Pictures.Paste.Select
      Set myShape = Selection
      With myShape
      .Top = Rng.Top + 1 ‘points from top
      .Left = Rng.Left + 1 ‘points from left
      .Width = Rng.Width – 2 ‘points wide
      .Height = Rng.Height – 2
      .Placement = xlMoveAndSize
      End With

      Next i

      MyError:
      Range(“A1”).Select
      End Sub

      Reply
    8. Can you help with VBA codes that will convert a dynamic range to PDF and send to individual WhatsApp number

      Reply
    9. plz help me
      I need VBA code for for data entries form
      Id
      Name
      Adress
      Ph NO
      Deposit Monthly

      Reply
    10. Trying to find a way to log maintenance done on equipment. I have made a Table set that highlights when something is past due based on dates need to be done. I am trying to figure out if there is a way to track or make a back log of changes made so you can go back and see, O I did that on this day even outside of the preset dates. Thoughts?

      Reply
    11. Hi Puneet,

      I am hoping to make to leap into VBA/macro world having used Excel on a daily basis for many years!

      I followed the steps to create a PERSONAL.XLSB file and then added each of the modules above individually.

      Unfortunately, every time I open Excel I now receive a message from the .xlsb file as follows: ‘Microsoft Visual Basic for Applications – Compile error: – Expected: identifier’

      I am determined not to let this put me off and not to delete the file until I know more. I also felt it would be a waste of time spent in creating them.

      I did a quick Google search a found articles relating to reserved words but I doubt that I have any as I am only using the module above.

      Is this something you can help me with?

      I have no doubt they will be a quick hit game changer once I get them to run so thanks for your work!

      WK

      Reply
    12. Hi
      Can you please help me in writing a code to translate the below table A format to table B format

      Table A
      Style/Color Size
      852598/104 S
      M
      882087/404 38
      39
      40
      42
      —————————————
      Table B
      Style/Color Size
      852598/104 S M
      882087/104 38 39 40 42

      Reply
    13. Hello,
      I am a beginner in VBA programming and I have the following problem that I could not solve:
      I have 4 columns with data such as ID, raw material name, price and date. I transferred the data from the raw material name column to a ListBox, I selected a raw material name from the ListBox (column 2) and I transferred the corresponding line values to TextBox1, TextBox2, TextBox3 and TextBox4.up to this point I managed to solve problem. I want to change the values in TextBox1..4 and then transfer them back to the initial addresses (eg A2, B2, C2, D2 cells. I couldn’t solve this.

      If you can help me with some tips I would be grateful.
      Thank you in advance.

      Reply
    14. Hi Everyone,

      Can someone help me with my macro.
      I’m trying to create a macro that can put work week period align with the dates in column A from calendar in Sheet 2 (contains calendar from 2019-2020 with week period in column B). However, I’m not sure if it is possible. For example, March 5, 2020 will fall into Week 10.

      Thank you so much.

      Reply
    15. Hi Puneet

      Nice effort to allow users to use your codes.

      I have a sheet where in I wish to hide the rows with zero value.
      I want to select range of cells as range and wish to give them some formula based on vlookup…
      For example I have in one sheet purchase entries done

      On the next page I am doing the calculation of gst… So every time I have to change the row reference…As one column I have 2.5% gst.. other column 5%

      As of now every time in each column I have to every time change the cell reference or the row reference

      I wish to your advise

      Reply
    16. Hey, the codes mentioned above are amazing, i am so grateful for your help, it helped me learning alot from these codes and increase my efficiency.
      Just wanted to know one more thing can we use show details function in Pivot via VBA when we have given a multiple values in rows and we only need to open up some of them amongst all.

      Thankyou for this!!.

      Regards,
      Vinay Verma

      Reply
    17. hey I want to push messages from combobox (dropdown list) one by one to another text box, shall any body help on this

      Reply
    18. HI Punith,
      I need your advice on the macros codes on how to open embedded files in excel and trigger the owner of that file of the due date..

      Reply
    19. Thank you Punith. This is useful for us. I want to learn vba code. But feeling difficulty. How do i start as a fresher. Like first I need to start from userform or code line through module?
      give some easy tips Plse.

      Reply
    20. Hi Dear,

      May I have your assistance for VBA code Tab Order, I have made Invoice, I would like to use Tab for certain cells to fillup, for example, the cells are C3,C7,C9,D9,F7,F9,F11 and so on.
      Please, simple VBA code Tab Order, as simple as you can.
      Many thanks,

      Reply
    21. Hi,
      i have a query with regard macro.
      Function timestamp(Reference As Range)
      If Reference.Value “” Then
      timestamp = Format(Now, “dd-mmm-yy hh:mm:ss”)
      Else
      Ok = “”
      End If
      End Function

      this code show text format show date but i want date format please help sir.

      Reply
    22. Excuse me,
      can you tell me what is the wrong in this code

      Dim Name As String
      Dim Barcode As Long
      Dim vender As String

      Name = Sheets(“Add”).Range(“c5”).Value
      Barcode = Sheets(“Add”).Range(“c8”).Value
      vender = Sheets(“Add”).Range(“f14”).Value

      because this can’t run ( Barcode=sheets…………….)

      Reply
    23. Any advice on how to automate a search on Excel for over 3000 words/phrases from 20 different categories in a cell and return the category that contains the phrase? I don’t know any macro coding but am exploring this as an option since the manual formula is longer than the maximum cell character limit.

      Reply
    24. Hi Everyone,
      Thanks for gathering all Codes. It takes lot of work.
      I want to write code for Adding Rows for below details.

      A B C D E F
      1 24
      2 25
      3 28
      4 33
      Add 2 rows between A2 & A3 and
      Add 4 rows between A3 & A4.

      Thanks in advance.

      Reply
    25. Hi Puneet,
      I need your help, Actually I’m stuck with an error-> run-time error: ‘1004’, Method ‘Run’ of object ‘_Application’ failed and the highlighted line in {Application.Run Macro:=Range(“Datablock”)} where datablock is a named range which has already defined. It is very important to me. So, please Reply ASAP

      Reply
    26. Hi Everyone… i’m used report merging macro using text box and command button.

      Private Sub CommandButton2_Click()
      Dim fd As Object
      Dim add As String
      Dim wb As Workbook, wk As Workbook
      Dim myfiles As String
      Dim name As String
      If TextBox1.Text = “” Then
      MsgBox “Pls Select Path”, vbInformation
      Else
      Set fd = Application.FileDialog(msoFileDialogFilePicker)
      myfiles = Dir(“” + TextBox1.Text + “*.xlsx”)
      If myfiles = “” Then
      MsgBox “This folder haven’t Excel files… Can’t do further Process..”, vbInformation
      Else
      ThisWorkbook.Activate
      Worksheets.add
      On Error GoTo errHandler:
      ActiveSheet.name = “Summary”
      Sheets(“Lables”).Activate
      ActiveSheet.Range(“A1:AM1”).Select
      Selection.Copy
      ActiveSheet.Range(“A1”).Select
      Sheets(“Summary”).Activate
      ActiveSheet.Range(“A1”).Select
      ActiveSheet.Paste
      ActiveSheet.Range(“A2”).Select
      Do While myfiles “”
      Set wb = Workbooks.Open(“” + TextBox1.Text + “” & myfiles)
      name = ActiveSheet.name
      wb.Sheets(name).Activate
      wb.Sheets(name).Range(“A2:AM2”).Select
      wb.Sheets(name).Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      myfiles = Dir
      ThisWorkbook.Activate
      ThisWorkbook.Sheets(“Summary”).Activate
      If ActiveSheet.Range(“A2”) = “” Then
      ActiveSheet.Paste
      Application.CutCopyMode = False
      ThisWorkbook.Sheets(“Summary”).Columns.AutoFit
      ThisWorkbook.Sheets(“Summary”).Range(“A1”).Select
      Selection.End(xlDown).Select
      add = ActiveCell.Address
      wb.Sheets(name).Activate
      Application.CutCopyMode = False
      ActiveWorkbook.Close
      Else
      ActiveCell.Offset(1, 0).Select
      ActiveSheet.Paste
      Application.CutCopyMode = False
      ThisWorkbook.Sheets(“Summary”).Columns.AutoFit
      ThisWorkbook.Sheets(“Summary”).Range(“A1”).Select
      Selection.End(xlDown).Select
      add = ActiveCell.Address
      wb.Sheets(name).Activate
      Application.CutCopyMode = False
      ActiveWorkbook.Close
      End If
      Loop
      ActiveSheet.Range(“A1”).Select
      MsgBox “Process completed”, vbInformation
      End If
      End If
      errHandler:
      num = Sheets.Count
      If num > 3 Then
      MsgBox “Kindly delete previous data..!”, vbInformation
      ThisWorkbook.Sheets(“Summary”).Activate
      End If
      End Sub

      Reply
    27. Hi Puneet,

      Thanks for gathering all this code! Amazing work! I’m looking forward to test some of it during my day to day excel work.

      Keep it up! 🙂

      Reply
    28. Hi Sir,

      I have a query with regards to macros in excel, could I contact you via email?

      WIth Regards,

      Ankitha

      Reply
    29. i want to hyperlink my image with website url plz help me for hyperling my image! and i want to send it to outlook

      Sub Send_email_fromexcel()
      Dim edress As String
      Dim subj As String
      Dim message As String
      Dim filename, fname2 As String
      Dim outlookapp As Object
      Dim outlookmailitem As Object
      Dim myAttachments As Object
      Dim path As String
      Dim lastrow As Integer
      Dim attachment As String
      Dim x As Integer

      x = 2

      Set outlookapp = CreateObject(“Outlook.Application”)
      Set outlookmailitem = outlookapp.createitem(0)
      Set myAttachments = outlookmailitem.Attachments
      path = “C:UsersUserDesktopstatements”

      edress = Sheet1.Cells(x, 1)

      subj = Sheet1.Cells(x, 2)
      filename = Sheet1.Cells(x, 3)
      fname2 = “Weddingplz-Safe-Gold.jpg”

      attachment = path + filename

      outlookmailitem.to = edress
      outlookmailitem.cc = “”
      outlookmailitem.bcc = “”
      outlookmailitem.Subject = subj
      outlookmailitem.Attachments.Add path & fname2, 1

      outlookmailitem.htmlBody = “Thank you for your contract” _
      & “nicely done this work” _
      & “”
      outlookmailitem.htmlBody = “” & outlookmailitem.htmlBody & “”

      ‘outlookmailitem.body = “Please find your statement attached” & vbCrLf & “Best Regards”

      outlookmailitem.display
      ‘outlookmailitem.send

      lastrow = lastrow + 1
      edress = “”
      x = x + 1

      Set outlookapp = Nothing
      Set outlookmailitem = Nothing

      End Sub

      Reply
      • Sub ColorRow()

        Dim cel As Range
        Dim rng As Range
        Dim wrksht As Worksheet

        Set wrksht = ThisWorkbook.Worksheets(“Sheet1”) ‘put your worksheet name in place of sheet1
        Set rng = wrksht.Range(“A1:A10”) ‘Change “A1:A10” to your range

        For Each cel In rng
        If cel = “Whatever value” Then ‘insert your value in place of “Whatever Value”
        cel.EntireRow.Interior.ColorIndex = 3 ‘colors row red
        End If
        Next cel

        End Sub

        Reply
    30. Can you share a code which combines certain numbers (positive & negative) from a given table and calculates to a certain number (say ‘0’)?

      Reply
    31. hi guys,
      thanks for lot of codes posted, quite helpful,
      please i need a code to extract a particular worksheet from multiple workbooks saved in a folder without opening the workbook, using the sheet name as a criteria to search

      Reply
    32. so much thank you
      i need more helpful code for time function.
      1.i need to perfom the procedure/action in specific duration (not to start or scheduling the action). For example playing the game only for 1 minute, if > 1 minute the game stop automatically.
      2.If i have a cell with time format, how to execute the function? For example, i want to move the shape if the cell less or equal to “0:10:00” but if the cell contain over, lets say “0:15:00”, you can’t not activate the movement
      Thanks

      Reply
    33. Hi puneet
      Very useful blog
      Pl suggest any online classes
      As I am on maternity leave can give only around 1 hrs a dag.
      Secondly no knowledge of programming..
      Codes required for
      Auto sorting
      Removing duplicates
      Subtotaling of auto sorted
      Automatically adding the new name in the previously sorted data.
      Creating a balance sheet from trial balance
      Creating a customized bom…

      Reply
    34. Do you have something to read a json file from upcitemdb.com?
      I need to get price, picture and merchant link, if you have some vba to do that, please share Bro.

      Reply
      • @Prince
        There’s a Google Sheet Add-in. Scan barcodes and Run the add-in. I don’t know if it’s UPCITEMDB or a different database, but it gave me the results that you’re looking for.

        Reply
    35. I love the table of content code. Thank you so much! Is there a code to have a link to go back to the Table of Content on each of the other tabs?

      Reply
      • Hi Liz,
        This can be done by including something like this:

        Sub TableofContent()

        Dim i As Long, wks As Worksheet
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets(“Table of Content”).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets.Add(Before:=Sheets(1)).Name = “Table of Content”
        ‘ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
        ‘ActiveSheet.Name = “Table of Content”
        For i = 1 To Sheets.count
        With ActiveSheet
        .Hyperlinks.Add _
        Anchor:=ActiveSheet.Cells(i, 1), _
        Address:=””, _
        SubAddress:=”‘” & Sheets(i).Name & “‘!A1”, _
        ScreenTip:=Sheets(i).Name, _
        TextToDisplay:=Sheets(i).Name
        End With
        If Sheets(i).Name = “Table of Content” Then
        ‘Skip this page
        Else
        Sheets(i).Range(“A1”).Hyperlinks.Add Anchor:=Sheets(i).Range(“A1″), Address:=””, SubAddress:= _
        “‘Table of Content’!A1″, TextToDisplay:=”TOC”
        End If
        Next i
        End Sub

        Reply
    36. Hi when using below code I get an error message:
      Sub printSelection()
      Selection.PrintOutCopies:=1, Collate:=True
      End Sub
      Compile error Syntax error
      Am I doing something wrong?

      Reply
    37. Sub printSelection()
      Selection.PrintOutCopies:=1, Collate:=True
      End Sub
      gives an error message for me: Compile error Syntax error
      am I doing something wrong?

      Reply
    38. This is very helpful, as I am fully new to macro’s. Maybe a very basic q. If I for example use the following macro “1. Highlight Duplicates from Selection” how can I afterwards undo this? Other words is there also an “undo previous action” macro as in above case in my excel sheet the duplicate values remain coloured

      Reply
    39. Hi,
      I want to compare current report and previous report to master file. All of them has a two row. First compare current to master and print result if it is match. Second, compare previous to master file and print result if it match. I don’t know how to do in VBA. Can you please help me

      Reply
    40. Hi puneet, It’s extremely nice efforts. everyday I’am learning something from the website but couldn’t save the PDF file. can you please share me the PDF document to my mail id (someshar.ars@gmail.com)
      Thank you

      Reply
    41. Paste as linked picture was nice. I had used record macro to get the basic code for it, but yours is much simpler and cleaner.
      My most often used macro is to Paste as Values (instead of copying the formula)
      Sub PasteValues()
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      End Sub
      (again recorded). I use Ctrl+Shift+V as a shortcut, so after copying with Ctrl+C, I can paste formulas or values based on whether I press shift along with my Ctrl+V
      Another 1 I use is for borders, keyboard shortcut: Ctrl+Shift+B
      Sub Border()
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlInsideVertical)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlHairline
      End With
      End Sub
      I have also 1 user form designed as a general Notification to tell me that the macro is running, and then to update after execution is completed. Similarly, I have a user form as a progress bar.
      Instead of manually setting up the user forms each time, I have separate macros that update the user form and enable/disable screen updating and auto calculation.
      Eg:
      Sub MacroStart()
      Notification.Button.Enabled = False
      Notification.Message.Caption = “Macro running… Please Wait”
      Notification.Show (vbModeless)
      Application.ScreenUpdating = False
      Application.Calculation = xlManual
      Notification.Repaint
      End Sub
      Sub MacroStop()
      Application.ScreenUpdating = True
      Application.Calculation = xlAutomatic
      Notification.Button.Enabled = True
      Notification.Message.Caption = “Macro execution completed”
      Notification.Repaint
      End Sub
      I can just call MacroStart at the start of each macro, and MacroStop at the end of the macro, and those handle all the user form and enable/disable stuff for me.

      Reply
    42. Hello,
      I have a macro which will consolidate all workbooks to single sheet but i need to have files names as well in each row to indentify how many lines from workbook

      Reply
    43. I particularly like this code for Superscripting when I want to show X squared for example. It can be modified to subscript as well and to return back to regular text.
      When writing out problems with formulas for students this can be easier than using the format/ cell with the mouse.
      ActiveCell.FormulaR1C1 = “X2”
      With ActiveCell.Characters(Start:=1, Length:=1).Font
      .Name = “Calibri (Theme Body)”
      .FontStyle = “Regular”
      .Size = 12
      .StrikeThrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      End With
      With ActiveCell.Characters(Start:=2, Length:=1).Font
      .Name = “Calibri (Theme Body)”
      .FontStyle = “Regular”
      .Size = 12
      .StrikeThrough = False
      .Superscript = False
      .Subscript = True
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      End With
      End Sub

      Reply
    44. i need one help a3 cell value is 20 so need left to right rented value 20 time (1111111111111) (b3 cell 1 c3 cell 1 d3 cell 1)

      Reply
    45. Thank You Very Much.Its all very useful. I suggest one thing please comment how to use the each codes some of the codes can run only by coder.

      Reply
    46. Hai,
      I need the numbers 1-100 or 1-1000 in a jumbling manner. is there any code, i need it very urgently. pls. can u help me in this.

      Reply
    47. Hey Buddy,
      thanks a ton. your macros are of great help.
      can you create a macro wherein i can remove formulas from cells where cell value is not in percentage.

      Reply
    48. Hi,
      I dont know macro well.
      I want a code where I just put data in sheet1 and the pivot charts automatic created. Can anyone please help me on this.
      It is very urgent.

      Reply
    49. In this below code how I will define range. I just put data in sheet1 I dont know the data size like how much column and row are present in the data. So I want to put some dynamic range so that any data can useful.
      Please help ASAP.
      Sub Macro2()

      ‘ Macro2 Macro


      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
      Sheets.Add
      ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
      “Sheet1!R1C1:R6C73″, Version:=xlPivotTableVersion15).CreatePivotTable _
      TableDestination:=”Sheet2!R3C1″, TableName:=”PivotTable1”, DefaultVersion _
      :=xlPivotTableVersion15
      Sheets(“Sheet2”).Select
      Cells(3, 1).Select
      With ActiveSheet.PivotTables(“PivotTable1”).PivotFields(“Created Date”)
      .Orientation = xlRowField
      .Position = 1
      End With
      ActiveSheet.PivotTables(“PivotTable1”).AddDataField ActiveSheet.PivotTables( _
      “PivotTable1”).PivotFields(“Incident Id”), “Count of Incident Id”, xlCount
      ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
      ActiveChart.SetSourceData Source:=Range(“Sheet2!$A$3:$B$8”)
      End Sub

      Reply
    50. Dear Puneet,
      This site is amazing and i get to learn something new every passing day. Sincere thanks for your time and initiative.
      I am trying to create a date stamp button (using form control) that will add customized date and time of printing in the excel footer – using a specific font, font size and font color (e.g. Veranda, 8pt, Blue)
      The end result would look something like this:
      Printed on dd-mmm-yyyy at hh:mm:ss
      I don’t want the time stamp to be inserted automatically, but rather use a form control button to insert the same when clicked.
      Could you kindly help me with the VBA code please? It will be a great help!
      TIA for you help & warm regards
      Ranjitha

      Reply
    51. Hi Puneet
      I am looking for a stock report with a huge data my requirement is
      Material dispatch planning (Main Moto – FIFO Basis)
      Outstanding Orders

      Reply
    52. Hi Punnet
      First of all ” Thanks a lot for the Great Work ”
      I am looking for a code that will consolidate data from multiple excel files in a specific folder to a new blank excel file.

      Reply
      • I hope below 2 VBA Code will help you in your question…
        1. Combine Multiple Workbooks into One Workbook:
        Sub GetData()
        Dim sh As Worksheet
        Path = “D:\(Give Path Name where all excel files are saved)\”
        Filename = Dir(Path & “*.xlsx”)
        Do While Filename “”
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
        For Each sh In ActiveWorkbook.Worksheets
        ‘If LCase(Left(sh.Name, 5)) = “model” Then
        sh.Copy After:=ThisWorkbook.Sheets(1)
        ‘End If
        Next sh
        Workbooks(Filename).Close
        Filename = Dir()
        Loop
        End Sub
        2. To Combine Multiple Worksheets into One WorkSheet.:
        Sub Combine()
        Dim J As Integer
        On Error Resume Next
        Sheets(1).Select
        Worksheets.Add
        Sheets(1).Name = “Data”
        Sheets(2).Activate
        Range(“A1”).EntireRow.Select
        Selection.Copy Destination:=Sheets(1).Range(“A1”)
        For J = 2 To Sheets.Count
        Sheets(J).Activate
        Range(“A1”).Select
        Selection.CurrentRegion.Select
        Selection.Offset(1, 0).Resize(Selection.Rows.Count – 1).Select
        Selection.Copy Destination:=Sheets(1).Range(“A65536”).End(xlUp)(2)
        Next
        End Sub

        Reply
        • Hi sir,
          i need your help.
          I will download one file 10000 lines coming one excel sheet.
          every line mentions the Projects No.
          Project no wise split the data to convert the workbook
          if it is possible to share the coding

          Reply
    53. Hello,
      I would like to know the VBA code to copy an active sheet to multiple sheets in the same work book.
      Thank you

      Reply
    54. ExcelChamps, Good evening. I’m new to VBA. Excuse me if my question too silly. I have a column in which there will be names of cities. If I type/select that name from drop down list, excel should populate pin code number in the next column. Also some other columns to be autofilled. For example, point of contact name and number of that city. My EmailID is sree21343@gmail.com. Thanks in advance

      Reply
      • Hello, I’m here for the same reason, looking for where I can find people to help me populate some data in excel. Did you get any answer, I would really like to know if I can get any help.

        Reply
    55. Hi I am Looking for a way to convert a Rage Named which is and auto Start Name xls in XP Excel 97-2003 to vba code in Excel 2010 Windows 10 Is there a Way? or do I just need to start over?

      Reply
    56. I could not get the code for highlighting the row and column of the cell I’m working on to function:
      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      Dim strRange As String
      strRange = Target.Cells.Address & “,” & _
      Target.Cells.EntireColumn.Address & “,” & _
      Target.Cells.EntireRow.Address
      Range(strRange).Select
      End Sub
      Any suggestions?

      Reply
      • It worked for me when changing the quotation marks from “” to “”
        Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        Dim strRange As String
        strRange = Target.Cells.Address & “,” & _
        Target.Cells.EntireColumn.Address & “,” & _
        Target.Cells.EntireRow.Address
        Range(strRange).Select
        End Sub

        Reply
    57. Here are some of the codes I use on a daily basis.
      Function ConvertColumnNumberToLetter(colNum)
      ‘Getting the address of the first row and the colNum column number
      colAdr = ActiveWorkbook.ActiveSheet.Cells(1, colNum).Address
      With Application.WorksheetFunction
      colLetter = .Find(“$”, colAdr, 2) ‘Finding the second $-sign in the address
      ConvertColumnNumberToLetter = Mid(colAdr, 2, colLetter – 2) ‘Extracting the middle part of the address, containing only the letter(s) and returning it/them
      End With
      End Function
      Function ConvertColumnLetterToNumber(colLet As String)
      With ActiveWorkbook.ActiveSheet
      colAdr = .range(colLet & 1).Address ‘Getting the address of the first row and the colNum column number
      ConvertColumnLetterToNumber = .range(colAdr).Column ‘Getting the column number of the address
      End With
      End Function
      Function SendSelectionAsEmail(rng As range, subj As String, sendTo As String, Optional ccTo As String, Optional intro As String)
      ‘ Select the range of cells on the active worksheet.
      ActiveSheet.range(rng).Select
      ‘ Show the envelope on the ActiveWorkbook.
      ActiveWorkbook.EnvelopeVisible = True
      ‘ Set the optional introduction field thats adds
      ‘ some header text to the email body. It also sets
      ‘ the To and subject lines. Finally the message
      ‘ is sent.
      With ActiveSheet.MailEnvelope
      .Introduction = intro
      .Item.To = sendTo
      .Item.CC = ccTo
      .Item.Subject = subj
      .Item.Send
      End With
      End Function
      Function ConvertCollectionToArray(col As Collection)
      Dim arr() As Variant
      ReDim arr(1 To col.Count) As Variant
      For i = 1 To col.Count
      arr(i) = col(i)
      Next i
      toArray = arr
      End Function
      Function LastRow(ws As Worksheet, columnNumberToCheck)
      LastRow = ws.Cells(Rows.Count, columnNumberToCheck).End(xlUp).Row
      End Function
      Function LastColumn(ws As Worksheet, rowNumberToCheck)
      LastColumn = ws.Cells(rowNumberToCheck, Columns.Count).End(xlToLeft).Column
      End Function
      Function GetLastRowAdvaned(ws As Worksheet, endColumnNumber) ‘Looping through all columns from 1 to the end column number and finding the max value
      maxVal = 0
      For i = 1 To endColumnNumber
      If LastRow(ws, i) > maxVal Then
      maxVal = LastRow(ws, i)
      End If
      Next i
      GetLastRowAdvaned = maxVal
      End Function
      Function IsRowEmpty(ws As Worksheet, rowNumberToCheck, endColumnNumber) As Boolean
      Dim isEmpty As Boolean
      isEmpty = True
      For i = 1 To endColumnNumber
      If ws.range(Cells(rowNumberToCheck, i).Address) = “” Then
      IsRowEmpty = True
      Else
      IsRowEmpty = False
      GoTo EndFunction:
      End If
      Next i
      EndFunction:
      IsRowEmtpy = isEmpty
      End Function

      Reply
    58. This macro will promt you to select a photo, then it will size the height ,width and insert it to a specific range.
      Sub Insert_Setup_Photo()
      ActiveSheet.Protect DrawingObjects:=False
      Dim picToOpen As String
      picToOpen = Application.GetOpenFilename _
      (Title:=”Select Setup Photo To Insert”)
      If picToOpen = “False” Then
      ActiveSheet.Protect DrawingObjects:=False, Contents:=True
      Exit Sub
      End If
      Dim shp As Shape, t As Double, l As Double, w As Double, h As Double, r As Integer
      Dim Cel As Range
      CellHeight = 375 ‘Final Image Height, maintains scale
      CellWidth = 670 ‘Final Image Width, maintains scale
      Set Cel = Range(“B5:M29”) ‘Cells image be centered
      With Cel
      Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picToOpen, _
      LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
      shp.Locked = False
      shp.Height = CellHeight
      If shp.Width > CellWidth Then
      shp.Width = CellWidth
      End If
      shp.Left = .Left + ((.Width – shp.Width) / 2)
      shp.Top = .Top + ((.Height – shp.Height) / 2)
      End With
      ActiveSheet.Protect DrawingObjects:=False, Contents:=True
      End Sub

      Reply
    59. I Would like move the cursor from active cell to one cell left,right(From selected cell)..same thing to Up and Down by writing macros, Could you please help out resolve the task. I tried to write the below but its not working fine. Please let me know.
      Sub Left(). Ex: Hear Activecell is C2
      activecell.offset(0,-1).select -> hear it moves B2 cell
      end sub
      sub right()
      activecell.offset(0,1) .select -> hear it moves C2 But I want to move to D2. Same thing to Up and Down
      end sub
      Thanks,
      Vivek.

      Reply
    60. hi, I want to create Outlook email macro where emails automatically gets saved in to shared drive. Help needed with coding if anyone knows.

      Reply
    61. hi punnet sir
      thank you for providing macro code. These codes provide me the advantage of time in my work. these coding also provide my coding awareness . after having understood from these 100 codes. I have started creating small macro coding.
      thank you very much.

      Reply
    62. Hi Puneet,
      Great job.
      Shall i get code for deleting rows if any of the column contains blank cells
      Thanks

      Reply
    63. I need VBR code to work across all worksheets in a workbook a future date will be manually entered in the same cell on every sheet and new sheets are created daily. On the actual day of the date entered an email notification would be sent out I also need the worksheet name in the email so I will know which sheet is due.

      Reply
    64. Dear, I am using following code for transferring data from one sheet to another sheet, three variable parameters, i.e. between two dates and center which are selected from Dropdown menu from Main sheet.
      Programme run successfully, but each record written, i should press cancel button, after last record transfer, all data changed. I think, there is formula on CRM(Data) sheet and while transferring data formula also transferred, so data will be changed after running.
      Pl guide me in the matter.
      Sub Module()
      ‘SelectDataBetweenTwoDates()
      ‘declare variables
      Dim fromDate, toDate
      Dim MyResults As Worksheet, myData As Worksheet, MyDates As Worksheet
      Dim mModule As String
      Set MyResults = Worksheets(“MODCRM”)
      Set myData = Worksheets(“CRM”)
      Set MyDates = Worksheets(“Main”)
      ‘clear previous results
      MyResults.Range(“$A$3:$K$450”).ClearContents
      ‘attribute date values to variables
      fromDate = MyDates.Range(“D7”).Value
      toDate = MyDates.Range(“D9”).Value
      mModule = MyDates.Range(“D5”).Value
      ‘convert to text format to allow filtering
      fromDate = Format(fromDate, “dd-mmm-yyyy”)
      toDate = Format(toDate, “dd-mmm-yyyy”)
      With myData
      ‘removes autofilter
      If .FilterMode Then .ShowAllData
      ‘filter the data based on selected date values
      .Range(“$A$2:$K$2”).AutoFilter field:=7, Criteria1:= _
      “>=” & fromDate, Operator:=xlAnd, Criteria2:=”<=" & toDate
      .Range("$A$2:$K$2").AutoFilter field:=4, Criteria1:=mModule
      'copy the filtered data
      .UsedRange.SpecialCells(xlCellTypeVisible).Copy
      'paste copied values to results sheet
      MyResults.Range("A1").PasteSpecial
      End With
      ' remove autofilter in mydata
      'select cell A1 in results sheet
      MyResults.Activate
      MyResults.Range("A1").Select
      End Sub
      Please any one can guide me in the matter.
      while copying (xlCellTypeVisible) data copied with formula instead of values only.
      Pl guide me in the matter.
      Ravi Patel

      Reply
    65. Hi,
      I am using macro for auto filter on multiple filter with between dates and center, every thing is run successfully, but i have to press cancel button at every record then record display on screen, after last record, all record changed this i due to formula on sheet,
      Any one help me.

      Reply
    66. Hi,
      I have Stock and requiremets and required Output as given below.
      Stock
      Mat Code Mat Description Batch Avlb STK
      DS1977S40014C01 CO/SAT/400TC/114/IVORY C16184204 100
      DS1977S40014C01 CO/SAT/400TC/114/IVORY C16184206 100
      DS1977S40014C01 CO/SAT/400TC/114/IVORY G15833208 100
      DS1977S40014C01 CO/SAT/400TC/114/IVORY C16150304 750
      DS1977S40014C01 CO/SAT/400TC/114/IVORY C16151502 250
      DS1977S40014C01 CO/SAT/400TC/114/IVORY C16151501 250
      DS1977S40014C01 CO/SAT/400TC/114/IVORY C16150305 600
      Requirements
      SR NO Mat Code Mat Description SO Req Qty
      3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 300.000
      3161313573 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000
      3161313574 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000
      3161313575 DS1977S40014C01 CO/SAT/400TC/114/IVORY 350.000
      3161313576 DS1977S40014C01 CO/SAT/400TC/114/IVORY 500.000
      3161313538 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000
      3161313539 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000
      3161313540 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200.000
      Required OutPut:-
      SR No Mat Code Mat Description Req. Qty Batch Available qty Consumed remarks
      3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 100 C16184204 100 100 SO qty Spilt
      3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 100 C16184206 100 100 SO qty Spilt
      3161313530 DS1977S40014C01 CO/SAT/400TC/114/IVORY 100 G15833208 100 100 SO qty Spilt
      3161313573 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150304 750 200 Batch qty Spilt
      3161313574 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150304 550 200 Batch qty Spilt
      3161313575 DS1977S40014C01 CO/SAT/400TC/114/IVORY 350 C16150304 350 350 Batch qty Spilt
      3161313576 DS1977S40014C01 CO/SAT/400TC/114/IVORY 250 C16151502 250 250 SO qty Spilt
      3161313576 DS1977S40014C01 CO/SAT/400TC/114/IVORY 250 C16151501 250 250 SO qty Spilt
      3161313538 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150305 600 200 Batch qty Spilt
      3161313539 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150305 400 200 Batch qty Spilt
      3161313540 DS1977S40014C01 CO/SAT/400TC/114/IVORY 200 C16150305 200 200 Batch qty Spilt
      Pls help on this..

      Reply
    67. Sub SaveAs()

      ‘ SaveAs Macro

      ‘ Keyboard Shortcut: Ctrl+Shift+A

      ChDir “D:”
      ActiveWorkbook.SaveAs Filename:= _
      “D:gst Billing System2018.xlsm”, FileFormat:= _
      xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      ChDir “E:JSM”
      ActiveWorkbook.SaveAs Filename:=”E:JSMBilling System2018.xlsm”, FileFormat:= _
      xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      End Sub

      Reply
    68. Thanks Puneet, this is so helpful
      Need your help
      Can you help create a macro for this instance in excel:
      N/A
      Abc
      123
      (Blank Cell)
      XYZ
      N/A
      123-222
      N/A
      (Blank Cell)
      Answer: Abc, 123, XYZ and 123-222
      Thanks in advance

      Reply
    69. Hey Hi,
      Thanks for the codes.
      I need your help to count the excel cell colors which used by conditional formatting. I had tried many ways, but, no luck.
      Kindly let me know, if you can help.

      Reply
    70. Thank you for sharing code in easier way, this is very helpful. I am just beginner in macro. I have written a code to connect sql database but i m getting difficulty to connect more than one database from different server.

      Reply
    71. I’m getting a type mismatch when I run the ‘HighlightAlternateRows’ procedure. Debug shows this line as the culprit:
      ‘rng.Value = rng ^ (1 / 3)’
      Any help would be appreciated. Thanks

      Reply
      • I fixed it and it works!
        Sub Highlight AlternateRows ()
        Dim rng As Range
        __For Each rng In Selection.Rows
        ____If rng.Row Mod 2 = 1 Then
        ____rng.Style = “20% – Accent1”
        ____Else
        ____End If
        __Next rng
        End Sub
        (underscores added to show proper indenting)

        Reply
    72. 1. In Insert Multiple Rows please change the word “columns” by “rows” in
      i = InputBox(“Enter number of columns to insert”, “Insert Columns”)
      2. Closing Message
      “You can use close_open to perform a task on opening a file. All you have to do just name your macro
      “close_open”.”
      Sub auto_close()
      The name of the macro is not “close_open”
      3. Count/Highlight Cells With Error In Entire Worksheet
      These statements must be in different lines:
      i = i + 1 rng.Style = “bad”
      4. In Count/Highlight Cells With A Specific In Entire Worksheet please add the word “Value” after “Specific”

      Reply
    73. Although it worked for me, in the first Basic Macro, I have two observations:
      1) I think that the For loop must be something like:
      Dim j as integer
      For j = 1 to i
      ActiveCell.Value = j
      ActiveCell.Offset(1, 0).Activate
      Next j
      that is, replace “i” by j in the index variable for the loop
      2) As I said, your original code works but I think that the index variable must be different to the inputbox variable.
      Sincerely yours,
      Carlos

      Reply
    74. Hello! I would like a very specific code that I haven’t been able to find anywhere on the internet…
      I’m wanting the macro to identify blank cells in Row 1 only, delete the blank cells (in Row 1) & shift those columns’ cells up. Any advice??

      Reply
      • Try this:
        ‘ DeleteBlankCellsinRow1 Macro
        Sub DeleteBlankCellsinRow1()
        Rows(“1:1”).Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp
        End Sub

        Reply
    75. Great list, but it would be nice if you made it easier for us to identify changes in it since you say you make monthly changes.
      Rather than a PDF, how about putting this tips in a downloadable spreadsheet or Word document that the tips can be sorted by insertion date as well as category. Actually. If you make the download cumulative that would be even better. So each month we could replace the old file with the new one, containing the all of the tips you’ve published here over time. Even if you start now building the cumulative file, that would be better.

      Reply
    76. Hello Sir,
      I want to learn how to create macro. I have the basic knowledge of VB. Please advise from where should I start.

      Reply
    77. Sir, It’s extremely nice efforts. Would you save your precious time to modify one code of you you did? I need it should ask us location to save ask us to rename the file name before save………in the code for “Save Selected Range as a PDF” please modify this…..it will be beneficial for all…….please send me to bhaiswarpravin@gmail.com

      Reply
    78. Hello, really nice to see all these. is there any macro to copy data from different file to master file. if yes then can anyone please share

      Reply
    79. Nice Work.
      I was also trying to get in touch with you to understand if there is a way we can filter a table based on unique values
      Let’s say we have the following table on the meetings done by a person, and the start time of each meeting
      Date Start Time
      ———- ————–
      Aug 24 9:00 AM
      Aug 24 10:00 AM
      Aug 24 1:45 PM
      Aug 24 4:45 PM
      Aug 25 8:00 AM
      Aug 25 2:00 PM
      Aug 25 5:00 PM
      Aug 26 12:30 PM
      Aug 26 2:00 PM
      Aug 26 4:29 PM
      Aug 26 8:28 PM
      Now I need to calculate the average start time for the period (say week / month) from such a table.
      How to do so?
      The best way I have right now is copy both the columns, and check for duplicates in the Date column, followed by which I get to calculate the average start time. Something like this.
      Date Start Time
      ——— ——————-
      Aug 24 9:00 AM
      Aug 25 8:00 AM
      Aug 26 12:30 PM
      Can we build a formula to decrease the above task.

      Reply
    80. Great Puneet! Many of these are new & innovative for me. I am sure it will help me save my hours of daily work. Thanks much

      Reply
    81. How to transfer a cell value from main workbook to several workbooks via VBA program, without opening the other several workbooks.

      Reply
    82. Hey, great macros. Question, I’m using macro 31 “add rows textbox” I’m adding rows at line 35 and then I need to copy the formula from h34 down to all the new rows. Could you help with this addition?

      Reply
        • Here is what I currently have:
          Sub InsertMultipleRows()
          Dim i As Integer
          Dim j As Integer
          Rows(“35:35”).Select
          On Error GoTo Last
          i = InputBox(“Enter number of items to add”, “Insert Items”)
          For j = 1 To i
          Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
          Next j
          Last:
          Range(“H34”).Select
          Selection.AutoFill Destination:=Range(“H34:H35”), Type:=xlFillDefault
          ‘Range(“H34″+i).Select (This is the part I need help with)
          Range(“C35”).Select
          Exit Sub
          End Sub

          Reply
    83. Hi Puneet.. It’s a great website and I’m learning something every day. Thanks for that..
      Save as PDF Command not working, can you please help. ?

      Reply
        • hi Puneet, when saving to PDF I get the following error
          Compile error: statement outside type block
          the sentence “for each … Nextws” is shown in RED in 1 entire line
          Sub SaveWorkshetAsPDF()
          Dimws As Worksheet
          For Each ws In Worksheetsws.ExportAsFixedFormat xlTypePDF, “ENTER-FOLDER-NAME-HERE” & ws.Name & “.pdf” Nextws
          End Sub

          Reply
    84. Thanks Punit for sharing Wonderful Excel tricks….Helped me to automate my few daily routine task in one go….

      Reply
    85. hi!
      i work a lot with vba, a have some codes that can be useful, lake a parametric sendMail or send a worksheet or range as body mail. if you wan to add the just get in touch.
      by the way, thanks for share some codes.

      Reply
        • Hi Everyone,

          I’m using the below code to send PDFs using outlook.
          However, i need it to use a different email address in my outlook instead of the default one

          Any suggestions would be greatly appreciated
          Thanks in advance

          Sub SendEmailWithPDF(bTest As Boolean)
          Dim wsM As Worksheet
          Dim wsL As Worksheet
          Dim wsR As Worksheet
          Dim wsS As Worksheet
          Dim rngL As Range
          Dim rngSN As Range
          Dim rngTN As Range
          Dim rngPath As Range
          Dim c As Range
          Dim lSend As Long
          Dim lSent As Long
          Dim lCount As Long
          Dim lTest As Long
          Dim lOff As Long

          Dim OutApp As Object
          Dim OutMail As Object
          Dim strSavePath As String
          Dim strPathTest As String
          Dim strPDFName As String
          Dim strSendTo As String
          Dim strSubj As String
          Dim strBody As String
          Dim strMsg As String
          Dim strConf As String

          On Error GoTo errHandler
          Application.ScreenUpdating = False
          Application.DisplayAlerts = False

          strMsg = “Could not set variables”
          Set wsM = wksMenu
          Set wsS = wksSet
          Set wsL = wksList
          Set wsR = wksRpt
          Set rngL = wsL.Range(“StoreNums”)
          Set rngSN = wsR.Range(“rngSN”)
          Set rngTN = wsS.Range(“rngTN”)
          Set rngPath = wsS.Range(“rngPath”)
          ‘test email address
          strSendTo = wsS.Range(“rngSendTo”).Value

          lCount = rngL.Cells.Count
          ‘#columns offset for email address
          lOff = 3

          If bTest = True Then
          strConf = “TEST Emails: ”
          lTest = rngTN.Value
          If lTest > 0 Then
          lCount = lTest
          End If
          Else
          strConf = “STORE Emails: ”
          End If

          strConf = strConf & lCount _
          & ” emails will be sent”

          If bTest = True Then
          If strSendTo = “” Then
          MsgBox “Enter a test email address” _
          & vbCrLf _
          & “and try again.”
          GoSettings
          GoTo exitHandler
          Else
          strConf = strConf & vbCrLf _
          & “to ” & strSendTo
          End If
          End If

          strConf = strConf & vbCrLf & vbCrLf
          strConf = strConf & “Please confirm: ” _
          & vbCrLf & _
          “Do you want to send the emails?”

          lSend = MsgBox(strConf, _
          vbQuestion + vbYesNo, “Send Emails”)

          If lSend = vbYes Then
          strSubj = wsS.Range(“rngSubj”).Value
          strBody = wsS.Range(“rngBody”).Value
          strSavePath = rngPath.Value

          strMsg = “Could not test Outlook”
          On Error Resume Next
          Set OutApp = _
          GetObject(, “Outlook.Application”)
          On Error GoTo errHandler

          If OutApp Is Nothing Then
          MsgBox “Outlook is not open. ” _
          & vbCrLf _
          & “Open Outlook and try again”
          GoTo exitHandler
          End If

          strMsg = “Could not set path” _
          & ” for PDF save folder”
          If Right(strSavePath, 1) “\” Then
          strSavePath = strSavePath & “\”
          End If

          If DoesPathExist(strSavePath) Then
          ‘continue code below,
          ‘ using strSavePath
          Else
          MsgBox “The Save folder, ” _
          & strSavePath _
          & vbCrLf & “does not exist.” _
          & vbCrLf & _
          “Files could not be created.” _
          & vbCrLf & _
          “Please select valid folder.”
          wsS.Activate
          rngPath.Activate
          GoTo exitHandler
          End If

          strMsg = “Could not start mail process”
          For Each c In rngL
          rngSN = c.Value

          strMsg = “Could not create PDF for ” _
          & c.Value
          strPDFName = “SalesReport_” _
          & c.Value & “.pdf”
          If bTest = False Then
          strSendTo = c.Offset(0, lOff).Value
          End If
          wsR.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=strSavePath _
          & strPDFName, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=False

          Set OutMail = OutApp.CreateItem(0)

          strMsg = “Could not start mail for ” _
          & c.Value
          On Error Resume Next
          With OutMail
          .To = strSendTo
          .CC = “”
          .BCC = “”
          .Subject = strSubj
          .Body = strBody
          .Attachments.Add _
          strSavePath & strPDFName
          .Send
          End With
          On Error GoTo 0
          lSent = lSent + 1
          If lSent >= lCount Then Exit For
          Next c

          Application.ScreenUpdating = True
          wsM.Activate

          MsgBox “Emails have been sent”

          End If

          exitHandler:
          Application.ScreenUpdating = True
          Application.DisplayAlerts = True
          Set OutMail = Nothing
          Set OutApp = Nothing

          Set wsM = Nothing
          Set wsS = Nothing
          Set wsL = Nothing
          Set wsR = Nothing
          Set rngL = Nothing
          Set rngSN = Nothing
          Set rngPath = Nothing

          Exit Sub

          errHandler:
          MsgBox strMsg
          Resume exitHandler

          End Sub

          Reply