Macros code is visual basic for applications (VBA). Macros can be used in excel to automate tasks that are performed regularly and prevent you from manually performing them each and every time. The automation process by the use of macros in excel results in time-saving and produces quality, reliable work. You can create macros in excel by recording the steps of what you want to perform or writing them in person. Writing macros code yourself is advantageous since it gives you a greater scope of control over macros. By using macro, you can perform a wide range of tasks from simple formatting steps to complex export of excel sheets.
How to Run the Macros
1. Go to the Developer tab.
2. Click on Macros.
3. In the dialog box, select the macro you want to run.
4. Click on the Run button.
Below is a list of Macro codes to enable you to get started
Insert multiple columns
This code gives you the option of inserting multiple columns. When it is run, you will feed the number of columns you are interested in, then click ok. The columns will be added after the selected cell.
| Sub InsertMultipleColumns() Dim k As Integer Dim l As Integer ActiveCell.EntireColumn.Select On Error GoTo Last i = InputBox("Enter number of columns to insert", "Insert Columns") For l = 1 To i Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove Next l Last: Exit Sub End Sub |
To add the column before the selected cell, replace the code xIToRight with xIToLeft.
Autofit columns
This code will instantly Autofit all the columns in your Worksheet when you Run it.
| Sub AutoFitColumns()
Cells.Select Cells.EntireColumn.AutoFit End Sub |
Remove Text wrap
Removing text wrap code will help remove text wrap in the Worksheet by selecting all columns and removing text wrap.
| Sub RemoveTextWrap() Range("A1").WrapText = False End Sub |
Add header
This code has the ability to add a header when run.
| Sub AddCustomHeader() Dim inputText As String inputText = InputBox("Enter your text here", "Custom Header") 'Add custom text to the center header With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = inputText .RightHeader = "" End With End Sub To put a header or a footer date you can alternatively use this code; Sub DateInHeader() With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "&D" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" End With End Sub |
This macro simply uses the tag "&D" for adding the date. The header can be changed to the footer or side by replacing the " with the "&D." you can also add a specific date or desired header or footer by replacing the "&D" with your preference.
Highlight the active rows and columns
This code is resourceful when you want to analyze a data table.
| 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 |
A quick step to apply the code is to open VBE(ALT + F11), then go to project explorer, select your Workbook and double click the particular Worksheet to activate the macro, paste the code into it, and from the event drop menu, select "BeforeDoubleClick," it's all done close VBE.
Highlight named ranges
To ascertain how many names you have on your Worksheet, this code can help you 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 |
Highlight negative numbers
Sometimes your Worksheet may be big, and you may want to only get negative numbers. Macro code has you covered. This code will check every cell from the Range and select those cells with 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 |
Print narrow margin
When this macro code is run, it gives you the liberty to print a narrow margin depending on your set desire.
| 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 |
Unhide all hidden worksheets
By using this code, it enables you to unhide all hidden Worksheets.
| Sub UnhideAllWorksheets() Dim WS As Worksheet 'Loop through all Worksheet and set them to visible For Each ws In ActiveWorkbook.Worksheets ws.Visible = xlSheetVisible Next ws End Sub |
Resize all charts in a worksheet
If you have many charts and you want them to be organized to a consistent size, a macro can be of aid just by a single click.
'the width and height can be adjusted as desired by changing the values below.
| Sub Resize_Charts() Dim counter As Integer For counter = 1 To ActiveSheet.ChartObjects.Count 'change the height and width to the size required With ActiveSheet.ChartObjects(counter) .Width = 500 .Height = 300 End With Next counter End Sub |
Disable page break
Worksheets have page breaks, and you may at some point not prefer this. You can use this simple code to 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 |
Close all workbooks at once
Before closing, the macro code will first check all the workbooks one by one and have them closed. For those that are not saved, a message will pop up, alerting you whether to save it or not.
| Sub CloseAllWorkbooks() Dim wbs As Workbook For Each wbs In Workbooks wbs.Close SaveChanges:=True Next wb End Sub |
Refresh all pivot tables.
It is of essence to refresh your pivot tables when you are updating your data. Sometimes, you may forget to do so, but excel macros have made it easy by using this code.
| Sub vba_referesh_all_pivots() Dim pt As PivotTable 'With just one loop, refresh all pivot tables! For Each pt In ActiveWorkbook.PivotTables pt.RefreshTable Next pt End Sub |
Create a table of content
Anyone who has dealt with excel for a long time can testify that scrolling through a Worksheet that is voluminous is hectic and time-consuming. We can create a table of content using macros to make maneuvering easy for us. Just use this code. It will be fun.
| 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 |
Convert Range into an image
| Sub PasteAsPicture() Application.CutCopyMode = False Selection.Copy ActiveSheet.Pictures.Paste.Select End Sub |
Activate the data entry form
| Sub DataForm()
'Show the default data entry form ActiveSheet.ShowDataForm End Sub |
Convert all formulas into values
When you need to use a lot of volatile heavy functions or send a workbook free from all the sketchy and complex formulas- only the result of the calculations rather than the full excel model, it is essential that you convert all formulas to values. Macros help you by using this simple code.
| 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 |
Reverse Text
Reverse Text is not included in excel since it is not in use or let's say rarely used. But those who would want to use it to generate special code, for fun or need to see if a string is a palindrome may use the code below. This code has the ability to display Text backward- it actually converts the Text and puts it in reverse.
| Public Function ReverseText(ByVal cell As Range) As String 'Reverse text using this function ReverseText = VBA.strReverse(cell.Value) End Function 'Make sure you have a selection ready Sub ReverseTextInSelection() Dim range As Range Selection.Value= Selection.Value 'Loop through all the cells For Each Range In Selection 'Call your function range= ReverseText(range) Next Range End Sub |
Activate A1 reference style
| Sub ActivateA1() If Application.ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1 Else Application.ReferenceStyle = xlA1 End If End Sub |
Convert a date 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 |
Word count from the entire Worksheet
It is possible that as we work on an excel workbook, we may be interested in getting the word count. Unfortunately, Excel does not have an inbuilt word counter, but luckily we may use Macros code to resolve this problem. In relation to other ways that we may use, Macros have proven to be simple to use. The code below will do the word count for you.
| 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 |
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 |
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 |
Alternatively, you may use this as an option.
| Sub InsertNumbers() Dim maxNumber As Integer Dim counter As Integer On Error GoTo Last maxNumber = InputBox("Enter the Max Value", "Generate 1 to n") 'Generate all the numbers For counter = 1 To maxNumber ActiveCell.Value = counter 'Move one cell below ActiveCell.Offset(1, 0).Activate Next counter Last: Exit Sub End Sub |
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 |
Close all workbooks at once
This process takes place in two steps; the first is declaring an object variable to represent a workbook project, and the second loop all the open Workbook, finalize by saving and closing them.
| Sub CloseAllWorkbooks() Dim wbs As Workbook 'Loop through all workbooks and close them For Each wbs In Workbooks wbs.Close SaveChanges:=True Next wb End Sub |
If you don't want to save, change the SaveChange argument to false.
Save each Worksheet as a separate PDF
This code will help you create PDFs from worksheets.
|
Protect all worksheets instantly
It is possible to protect all your Worksheets. You will need to ask the user for the password then it will be used to protect the worksheets.
|
Sub ProtectAllWorksheets() Dim Worksheet As Worksheet Dim pword As String 'Get the user's password pword = InputBox("Enter a Password to secure your worksheets", "Password") 'Loop through the worksheets toprotect all of them For Each Worksheet In ActiveWorkbook.Worksheets worksheet.Protect Password:=pword Next Worksheet End Sub |
This code will simply enable you to protect the Worksheet with the user-given password.
Automatically insert the date and time stamp in the adjacent cells
To use this code, right-click the worksheet tab you intend to use and choose the view code from the appearing menu >> use the code below and save it. This will automatically put a new timestamp. Depending on your workbook preference Columns A and B can be changed, and the format of mm/dd/yy hh:mm:ss to what you desire.
| Private Sub Worksheet_Change(ByVal Target As Range) 'UpdatebyKutools20190919 Dim xRInt As Integer Dim xDStr As String Dim xFStr As String On Error Resume Next xDStr = "A" 'Data Column xFStr = "B" 'Timstamp Column If (Not Application.Intersect(Me.Range(xDStr & ":" & xDStr), Target) Is Nothing) Then xRInt = Target.Row Me.Range(xFStr & xRInt) = Format(Now(), "mm/dd/yyyy hh:mm:ss") End End |
Highlight blank cells
It is sometimes difficult to identify cells that are black, especially those containing a single space. This code may ease it up for you by checking them out and highlighting them.
| 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 |
Show a welcome message
|
This code will allow you to have a starting message in excel.
Highlight cells with comments
|
Highlight unique values
Sometimes it may be needful for you to find a list of unique values in excel. This code has simplified it all for you.
|
Print comments
If you are interested in printing only the comments, use this code.
|
Insert multiple worksheets
|
Delete all blank sheets
After finishing your work, there might be a necessity to clean up and remove the unnecessary blank sheets that were not used. This process can be automated using this code.
|
Add a workbook to a normal attachment
If you are done editing your Workbook and are now ready to send it via email, the process is already automated by running this code.
|
Sub AttachWorkbookIntoEmailMessage() Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) 'Let's create an email message and display it 'Remember to change the parameters below With OutlookMail .To = "support@myexcelonline.com" .Subject = "Have a look at this workbook." .Body = "Hey John, Could you help out on this?" .Attachments.Add ActiveWorkbook.FullName .Display End With Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub |
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 |
Paste the chart as an image
Depending on preference, sometimes you may need your chart as an image. This code enables you to convert your chart to an image. Use this code.
| Sub ConvertChartToPicture() ActiveChart.ChartArea.Copy ActiveSheet.Range("A1").Select ActiveSheet.Pictures.Paste.Select End Sub |
Insert a linked picture
The linked image is a feature in Excel that you can use to create dashboards wherein images can be resized and linked to the actual report. The code can aid in creating your own linked image.
|
Remove characters from a string
You can remove a character from starting of a text string by referring to a cell. You can alternatively insert a text into the function number of characters to remove from a text string. Two arguments are in consideration. "rng" for the text string and "cnt" for character count.
To remove the first character of a cell, enter 1 in cnt.
| Public Function removeFirstC(rng As String, cnt As Long) removeFirstC = Right(rng,Len(rng) – cnt) End |
Remove time and date
This code will help you delete rows based on the date.
| ' If Format(Cells(iCntr, 1), "dd-mm-yyyy") = Format(Now(), "dd-mm-yyyy") Then Rows(iCntr).Delete End If |
| Starting program and sub procedure to write VBA code to delete rows based on date. Sub sbDelete_Rows_Based_On_Date() 'Declaring the variable lRow as long to store the last row number Dim lRow As Long 'Declaring the variable iCntr as long to use in the For loop Dim iCntr As Long 'Assigning the last row value to the variable lRow lRow = 20 'Using for loop 'We are checking the each cell value if the cell value equals today's date. 'And deleting the row if true For iCntr = lRow To 1 Step -1 |
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
This code will check the Range of selected cells and convert it into uppercase text when run.
Macro code Removing a character from selection in excel
Sub removeChar()
Dim Rng As Range
Dim rc As String
rc = InputBox("characters", "Enter your Value")
For Each Rng In Selection
Selection.Replace What:=rc, Replacement:=""
Next
End Sub
Particular characters may be removed from a selected cell by using this code. An input box will display where you will enter the character you intend to remove.
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 |
Hide pivot table subtotals
Modifying pivot tables is one of the many functionalities entailed in Excel Macros. We can use macros modifying feature that hides pivot table subtotal using this code.
|
'Select a cell first from your pivot table Sub HidePivotTableSubtotals() Dim pTable As PivotTable Dim pField As PivotField On Error Resume Next 'Get the pivot table first Set pTable = ActiveSheet.PivotTables(ActiveCell.PivotTable.name) 'Check if a pivot table is found If pTable Is Nothing Then MsgBox "Please select a cell first from your Pivot Table." Exit Sub End If 'For each subtotal, make it hidden For Each pField In pTable.PivotFields pField.Subtotals(1) = True pField.Subtotals(1) = False Next pField End Sub |
Create a pivot table
To create a pivot table, eight steps are important.
1. Variable Declaration- you need first to declare the variables needed in our code to define different things
'Declare Variables
Dim PSheet As Worksheet (create a sheet for the pivot table)
Dim DSheet As Worksheet (use as datasheet)
Dim PCache As PivotCache (use as name for pivot table cache) Dim PTable As PivotTable(use as name for pivot table)
Dim PRange As Range(define a source of data range)
Dim LastRow As Long
Dim LastCol As Long
2. Insert a new worksheet
3. Define the Range of data
4. The next thing is to create a pivot cache
5. Insert a black pivot table
6. Add rows and columns
7. Put data fields
8. Lastly format pivot table
The code summary of the steps is simplified below and can be used to create a pivot table.
| Sub InsertPivotTable() 'Macro By ExcelChamps 'Declare Variables Dim PSheet As Worksheet Dim DSheet As Worksheet Dim PCache As PivotCache Dim PTable As PivotTable Dim PRange As Range Dim LastRow As Long Dim LastCol As Long 'Insert a New Blank Worksheet On Error Resume Next Application.DisplayAlerts = False Worksheets("PivotTable").Delete Sheets.Add Before:=ActiveSheet ActiveSheet.Name = "PivotTable" Application.DisplayAlerts = True Set PSheet = Worksheets("PivotTable") Set DSheet = Worksheets("Data") 'Define Data Range LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol) 'Define Pivot Cache Set PCache = ActiveWorkbook.PivotCaches.Create _ (SourceType:=xlDatabase, SourceData:=PRange). _ CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _ TableName:="SalesPivotTable") 'Insert Blank Pivot Table Set PTable = PCache.CreatePivotTable _ (TableDestination:=PSheet.Cells(1, 1), TableName:="SalesPivotTable") 'Insert Row Fields With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Year") .Orientation = xlRowField .Position = 1 End With With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Month") .Orientation = xlRowField .Position = 2 End With 'Insert Column Fields With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Zone") .Orientation = xlColumnField .Position = 1 End With 'Insert Data Field With ActiveSheet.PivotTables("SalesPivotTable") .PivotFields ("Amount") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Name = "Revenue " End With 'Format Pivot Table ActiveSheet.PivotTables("SalesPivotTable").ShowTableStyleRowStripes = True ActiveSheet.PivotTables("SalesPivotTable").TableStyle2 = "PivotStyleMedium9" End Sub |
Change chart type
Changing the property of the chart may be necessary at times when using Excel. This code can be captured in macros and may be helpful to automate the whole process.
|
'Select your chart first before running this Sub ChangeChartType() 'This is the clustered column chart, and you can change the type 'Other chart types are listed at: https://docs.microsoft.com/en-us/office/vba/api/Excel.XlChartType ActiveChart.ChartType = xlColumnClustered End Sub |
Use Text to speech
If you have an excel edition with Text to speech installed, you can make excel speak using Macros code.
To specify the cell text to be put to speech, use the code below. For example, our code will speak out cell A1 to change to A2 (1, 2) and so on.
| Sub SayThisCell() Cells(1, 1).Speak End Sub Macros can also speak the content of a string by using this code Sub SayThisString() Dim SayThis As String SayThis = "Using excel has given me a nice experience and has made it easy for me in accounting." Application.Speech.Speak (SayThis) End Sub |
Use goal seek
Goal seek is an amazing feature in excel that takes out the guesswork for you and predicts the value of the input needed to attain a specific goal. Let's say you expected outcome in mind but no idea of the starting amount that you should invest. Macros can help you execute such kinds of problems just by running this code.
|
'Make sure the Worksheet is selected to execute the Goal Seek on Sub GoalSeekVBA() Dim TargetGoal As Long 'Get the target value from the user. TargetGoal = InputBox("Enter the target value", "Enter Goal") 'Make sure to change the cell that you want to be changed with the goal ActiveSheet.Range("E9").GoalSeek _ Goal:=TargetGoal, _ ChangingCell:=Range("A9") End Sub |
Create a backup of a current workbook
If you have a very important workbook that you do not want to lose by any chance and need to frequently back it up, Macros has a Code to sort you out.
|
Sub CreateBackup() 'Create a backup on the specified folder with the date today included 'Don't forget to change folder." ThisWorkbook.SaveCopyAs Filename:="C:\ChangeMe\" & Format(Date, "mmddyyyy") & "-" & ThisWorkbook.name End Sub |
I wish this could be done exhaustively, but there is still a lot to learn. Learning is a lifetime work. Using excel is becoming easier and enjoyable and especially with the aid of macros code which automates processes. May this resource not be the end of it. Explore more.