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

Once you activate developer tab...

...you can use below steps to paste a VBA code into VB editor.

  • Go to your developer tab and click on "Visual Basic".
    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

...a list of top 100 macro 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.

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

Once you run this macro it will show an input box and you need to enter the number of columns you want to insert.

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

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

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.

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

6. Remove Text Wrap

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.

Sub RemoveWrapText()
Cells.Select
Selection.WrapText = False
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
End Sub

7. Unmerge Cells

Select your cells and run this code and it will un-merge all the cells from the selection with your loosing data.

Sub UnmergeCells()
Selection.UnMerge
End Sub

8. Open Calculator

In window there is a specific calculator and by using this macro code you can open that calculator directly from Excel use for your calculations.

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

9. Add Header/Footer Date

Use this code to add a date into the header or footer in your worksheet.

You can edit this code for switching from header to footer.

Sub dateInHeader()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&D"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
ActiveWindow.View = xlNormalView
End Sub

10. Custom Header/Footer

If you want to insert a custom header then this code is for you.

Run this code, enter custom value in the input box. To change the alignment of header or footer you can edit the code.

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

Formatting Codes

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

11. Highlight Duplicates from Selection

This macro will check each cell of your selection and highlight the duplicate values

You can also change the color from the code.

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

12. Highlight the Active Row and Column

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 wi ll not able to edit the cell by double click.

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

13. Highlight Top 10 Values

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

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

14. Highlight Named Ranges

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.

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

15. Highlight Greater than Values

Once you run this code it will ask you for the value from which you want to highlight all greater 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

16. Highlight Lower Than Values

Once you run this code it will ask you for the value from which you want to highlight all lower 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

17. Highlight Negative Numbers

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.

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

18. Highlight Specific Text

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.

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" GoToLInput
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

19. Highlight Cells with Comments

To highlight all the cells with comments use this macro.

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

20. Highlight Alternate Rows in the Selection

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.

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

21. Highlight Cells with Misspelled Words

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.

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

22. Highlight Cells With Error in the Entire Worksheet

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.

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

23. Highlight Cells with a Specific Text in Worksheet

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.

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

24. Highlight all the Blank Cells Invisible Space

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.

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

25. Highlight Max Value In The Range

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

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

26. Highlight Min Value In The Range

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

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

27. Highlight Unique Values

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

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

28. Highlight Difference in Columns

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

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

29. Highlight Difference in Rows

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

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

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

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.

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

31. Print Narrow Margin

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

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.PrintOutCopies:=1, Collate:=True,
IgnorePrintAreas:=False
End Sub

32. Print Selection

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.

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

33. Print Custom Pages

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.

Sub printCustomSelection()
Dim startpageAs Integer
Dim endpageAs 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.PrintOutFrom:=startpage, To:=endpage, Copies:=1
Collate:=True
End Sub

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

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.

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

35. Unhide all Hidden Worksheets

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

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

36. Delete all but the Active Worksheet

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.

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

37. Protect all Worksheets Instantly

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.

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

38. Resize All Charts in a Worksheet

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.

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

39. Insert Multiple Worksheets

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.

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

40. Protect Worksheet

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.

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

41. Un-Protect Worksheet

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.

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

42. Sort Worksheets

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

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

43. Protect all the Cells With Formulas

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

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

44. Delete all Blank Worksheets

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

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

45. Unhide all Rows and Columns

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

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

46. Save Each Worksheet as a Single PDF

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

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

47. Disable Page Breaks

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

Sub DisablePageBreaks()
Dim wbAs Workbook
Dim wksAs Worksheet
Application.ScreenUpdating= False
For Each wbIn Application.Workbooks
For Each ShtIn wb.WorksheetsSht.DisplayPageBreaks= False
Next Sht
Next wb
Application.ScreenUpdating= True
End Sub

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

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.

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

49. Close all Workbooks at Once

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.

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

50. Copy Active Worksheet into a New Workbook

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.

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

51. Active Workbook in an Email

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".

Sub Send_Mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "[email protected]"
.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

52. Add Workbook to a Mail Attachment

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

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

53. Welcome Message

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".

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

54. Closing Message

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".

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

55. Count Open Unsaved Workbooks

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

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

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

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.

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

57. Refresh All Pivot Tables

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.

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

58. Create a Pivot Table

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

59. Auto Update Pivot Table Range

If you are not using Excel tables then you can use this code to 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

60. Disable/Enable Get Pivot Data

To disable/enable GetPivotData function you need to use Excel option.

But with this code you can do it in a single click.

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

Charts Codes

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

61. Change Chart Type

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.

Sub ChangeChartType()
ActiveChart.ChartType = xlColumnClustered
End Sub

62. Paste Chart as an Image

This code will help you to convert your chart into an image.

You just need to select your chart and run this code.

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

63. Add Chart Title

First of all, you need to select your chart and the run this code.

You will get an input box to enter 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

Advanced Codes

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

64. Save Selected Range as a PDF

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.

Sub HideSubtotals()
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.n ame)
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

65. Create a Table of Content

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.

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

66. Convert Range into an Image

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.

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

67. Insert a Linked Picture

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

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

68. Use Text to Speech

Just select a range and run this code.

Excel will speak all the text what you have in that range, cell by cell.

Sub Speak()
Selection.Speak
End Sub

69. Activate Data Entry Form

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

Sub DataForm()
ActiveSheet.ShowDataForm
End Sub

70. Use Goal Seek

Goal Seek can be super helpful for you to solve complex problems.

Learn more about goal seek from here before you use this code.

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

71. VBA Code to Search on Google

Follow this post to learn how to use this 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

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

Simply convert formulas into values.

When you run this macro it will quickly change the formulas into absolute 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

73. Remove Spaces from Selected Cells

One of the most useful macros from this list.

It will check your selection and then remove all the extra spaces from that.

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

74. Remove Characters from a String

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.

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

75. Add Insert Degree Symbol in Excel

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

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

76. Reverse Text

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.

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

77. Activate R1C1 Reference Style

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

Sub DataForm()
ActiveSheet.ShowDataForm
End Sub

78. Activate A1 Reference Style

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

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

79. Insert Time Range

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

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

80. Convert Date into Day

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.

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

81. Convert Date into Year

This code will convert dates into years.

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

82. Remove Time from Date

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

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

83. Remove Date from Date and Time

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

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

84. Convert to Upper Case

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.

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

85. Convert to Lower Case

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.

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

86. Convert to Proper Case

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

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

87. Convert to Sentence Case

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.

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

88. Remove a Character from Selection

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.

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

89. Word Count from Entire Worksheet

It can help you to count all the words from a 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

90. Remove the Apostrophe from a Number

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

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

91. Remove Decimals from Numbers

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

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

92. Multiply all the Values by a Number

Let’s you have a list of numbers and you want to multiply all the number with a particular.

Just 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.

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

93. Add a Number in all the Numbers

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

Sub addNumber()
Dim rngAs Range
DimiAs 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

94. Calculate the Square Root

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.

Sub getSquareRoot()
Dim rngAs 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

95. Calculate the Cube Root

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.

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

96. Add A-Z Alphabets in a Range

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

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

97. Convert Roman Numbers into Arabic Numbers

Sometimes it’s really hard to understand Roman numbers as serial numbers. This code will help you to 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

98. Remove Negative Signs

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.

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

99. Replace Blank Cells with Zeros

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.

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

100th

It’s your turn now.

Yes.

I want you to share your favorite macro code with me which you use every day to save your time. In the end, I just want to say that some of these codes I use every day to increase my productivity and I’m sure it will also help you in your work.

About the Author

Puneet Gogia

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.

153 thoughts

Leave a Comment

Your email address will not be published.

  1. 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
  2. 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
  3. 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
  4. 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
  5. 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
  6. 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
  7. 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
  8. 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
  9. 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
  10. Hi Sir,

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

    WIth Regards,

    Ankitha

    Reply
  11. 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
  12. Can you share a code which combines certain numbers (positive & negative) from a given table and calculates to a certain number (say ‘0’)?

    Reply
  13. 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
  14. 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
  15. 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
  16. 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
  17. 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
  18. 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
  19. 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
  20. 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
  21. 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
  22. 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.[email protected])
    Thank you

    Reply
  23. 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
  24. 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
  25. 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
  26. 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
  27. 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
  28. 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
  29. 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
  30. 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
  31. 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
  32. 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
  33. 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
  34. 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
  35. 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
  36. 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 [email protected]</