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
Before you use these codes, make sure you have your developer tab on your Excel ribbon to access VB editor. Once you activate developer tab you can use below steps to paste a VBA code into VB editor.
Download the Free PDF
List of Top 100 macro Examples (CODES) for VBA beginners
I have added all the codes into specific categories so that you can find your favorite codes quickly. Just read the title and click on it to get the code.
- This is my Ultimate VBA Library which I update on monthly basis with new codes and Don't forget to check the VBA Examples Sectionꜜ at the end of this list.
- VBA is one of the Advanced Excel Skills.
- To manage all of these codes make sure to read about Personal Macro Workbook to use these codes in all the workbooks.
- I have tested all of these codes in different versions of Excel (2007, 2010, 2013, 2016, and 2019). If you found any error in any of these codes, make sure to share with me.
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 This macro code will help you to automatically add serial numbers in your Excel sheet which can be helpful for you if you work with large data.
To use this code you need to select the cell from where you want to start the serial numbers and when you run this it shows you a message box where you need to enter the highest number for the serial numbers and click OK. And once you click OK, it simply runs a loop and add a list of serial numbers to the cells downward.
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 With this code, you can enter multiple rows in the worksheet. When you run this code, you can enter the number of rows to insert and make sure to select the cell from where you want to insert the new rows. If you want to add rows before the selected cell, replace the xlToDown to xlToUp in the code.
4. Auto Fit Columns
Sub AutoFitColumns() Cells.Select Cells.EntireColumn.AutoFit End Sub
This code quickly auto fits all the columns in your worksheet. So when you run this code, it will select all the cells in your worksheet and instantly auto-fit all the columns.
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.
- Open VBE (ALT + F11).
- Go to Project Explorer (Ctrl + R, If hidden).
- Select your workbook & double click on the name of a particular worksheet in which you want to activate the macro.
- Paste the code into it and select the "BeforeDoubleClick" from event drop down menu.
- 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
About the Author
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.
Posted by: zacheryzacherykarlee0269161.blogspot.com
Source: https://excelchamps.com/blog/useful-macro-codes-for-vba-newcomers/
Post a Comment