In this article, I am going to show you some of the most amazing VBA Excel codes that you can use to optimize your work. VBA is a programming language, which can be used to extend the capabilities of MS Excel and other MS Office applications. It is extremely helpful for MS Excel users, because it can be used to automate your work and significantly improve your efficiency. This article will introduce you to VBA and show you some of the most useful, ready to use VBA codes out there. You can use these macro examples to create your own scripts that fit your own needs.
You do not need programming experience to take advantage of the information in this article, but you are expected to have basic knowledge of Excel. If you are a beginner user, I would recommend you to read the article 20 Excel Formulas You Should Start Using Now to learn more about Excel’s core functionalities.
I have prepared for you a number of ready to use VBA Excel Macro examples with great functionality that you can use to optimize your work. In order to use them, you need to “install” them in your Excel file. The next paragraph deals with Excel macro installation. Skip this part if you are already familiar with this.
How to install a macroIn Excel, press the key combination alt + F11. This will take you to the VBA editor in MS Excel. Then, right-click on the Microsoft Excel Objects folder on the left and select Insert => Module. This is the place where the macros are stored. To make use of the macro, you need to save the Excel document as macro-enabled. From the tab file => save as, choose save as macro-enabled workbook (the .xlsm extension) Now, it’s time to write your first macro!
1. Copy data from one file to another.
Very useful macro, as it shows how to copy a range of data from inside vba and how to create and name a new workbook. You can easily upgrade it to fit your own requirements:
Sub CopyFiletoAnotherWorkbook() 'Copy the data Sheets("Example 1").Range("B4:C15").Copy 'Create a new workbook Workbooks.Add 'Paste the data ActiveSheet.Paste 'Turn off application alerts Application.DisplayAlerts = False 'Save the newly file. Change the name of the directory. ActiveWorkbook.SaveAs Filename:="C:\Temp\MyNewBook.xlsx" 'Turn application alerts back on Application.DisplayAlerts = True End Sub
2. Show hidden rows
Occasionally, large Excel files contain hidden lines for better clarity. Here’s a macro that will unhide all rows from an active worksheet:
Sub ShowHiddenRows() Columns.EntireColumn.Hidden = False Rows.EntireRow.Hidden = False End Sub
3. Delete empty rows and columns
Blank rows in Excel are a problem with data processing. Here is how to get rid of them:
Sub DeleteEmptyRowsAndColumns() 'Declare your variables. Dim MyRange As Range Dim iCounter As Long 'Define the target Range. Set MyRange = ActiveSheet.UsedRange 'Start reverse looping through the range of Rows. For iCounter = MyRange.Rows.Count To 1 Step -1 'If entire row is empty then delete it. If Application.CountA(Rows(iCounter).EntireRow) = 0 Then Rows(iCounter).Delete 'Remove comment to See which are the empty rows 'MsgBox "row " & iCounter & " is empty" End If 'Increment the counter down Next iCounter 'Step 6: Start reverse looping through the range of Columns. For iCounter = MyRange.Columns.Count To 1 Step -1 'Step 7: If entire column is empty then delete it. If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then Columns(iCounter).Delete End If 'Step 8: Increment the counter down Next iCounter End Sub
4. Find a blank cell
Sub FindEmptyCell() ActiveCell.Offset(1, 0).Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop End Sub
5. Replace empty cells with a value.
As previously mentioned, blank cells interfere with data processing and the creation of pivot tables. Here is a code which replaces all blank cells with 0. This macro has a very large application because you can use it to find and replace N/A results, as well as other characters such as dots, commas or duplicate values:
Sub FindAndReplace() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Save the Workbook before changing cells? Select Case MsgBox("Can't Undo this action. " & _ "Save Workbook First?", vbYesNoCancel) Case Is = vbYes ThisWorkbook.Save Case Is = vbCancel Exit Sub End Select 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Check for zero length then add 0. If Len(MyCell.Value) = 0 Then MyCell = 0 End If 'Get the next cell in the range Next MyCell End Sub
6. Sort numbers
The following macro sorts in ascending order all numbers from the active cell’s column. Just double click any cell from a column you would like to sort. NB: You need to put the code in Sheet 1 and not in a module to work:
Private Sub Worksheet_BeforeDoubleClick (ByVal Target as Range, Cancel As Boolean) 'Declare your Variables Dim LastRow As Long 'Find last row LastRow = Cells (Rows.Count, 1) .End (xlUp) .Row 'Sort ascending on double-clicked column Rows ("6:" & LastRow) .Sort _ Key1: = Cells (6, ActiveCell.Column), _ Order1: = xlAscending End Sub
7. Remove empty spaces
Occasionally, data in the workbook contains additional spaces (spaces) that can interfere with data analysis and to corrupt of formulas. Here’s a macro that will remove all the spaces from a preselected range of cells:
Sub TrimTheSpaces() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Save the Workbook before changing cells Select Case MsgBox("Can't Undo this action. " & _ "Save Workbook First?", vbYesNoCancel) Case Is = vbYes ThisWorkbook.Save Case Is = vbCancel Exit Sub End Select 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Trim the Spaces. If Not IsEmpty(MyCell) Then MyCell = Trim(MyCell) End If 'Get the next cell in the range Next MyCell End Sub
8. Highlight dublicated values
Sometimes there are duplicate values in the several columns we would like to illuminate. Here’s a macro that does just that:
Sub HighlightDuplicates() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Ensure the cell has Text formatting. If WorksheetFunction.CountIf(MyRange, MyCell.Value) > 1 Then MyCell.Interior.ColorIndex = 36 End If 'Get the next cell in the range Next MyCell End Sub
9. Highlight top ten values
Sub TopTen() Selection.FormatConditions.AddTop10 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1) .TopBottom = xlTop10Top 'Change the rank here to highlight a different number of values .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
You can easily tweak the code to highlight different number of values.
10. Highlight greater than values
When you run this code, a window will prompt. It will ask you the value you want to compare the cells you have selected.
Sub HighlightGreaterThanValues() Dim i As Integer i = InputBox("Enter Greater Than Value", "Enter Value") Selection.FormatConditions.Delete 'Change the Operator to xlLower to highlight lower than values Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:=i Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1) .Font.Color = RGB(0, 0, 0) .Interior.Color = RGB(31, 218, 154) End With End Sub
You can tweak this code to highlight lower values as well.
11. Highlight cells with comments
A simple macro that highlights all the cells that contain comments:
Sub HighlightCommentCells() Selection.SpecialCells(xlCellTypeComments).Select Selection.Style= "Note" End Sub
12. Highlight Cells with Misspelled words
This is extremely useful when you work with functions that take strings, however, someone entered the string with a mistake and your formulas are not working. Here is how to fix this issue:
Sub ColorMispelledCells() For Each cl In ActiveSheet.UsedRange If Not Application.CheckSpelling(Word:=cl.Text) Then _ cl.Interior.ColorIndex = 28 Next cl End Sub
13. Create a pivot table
Here is how to create a pivot table from MS Excel (2007 version). Especially useful, when you are making a custom report every day. You can optimize the pivot table creation in the following way:
Sub PivotTableForExcel2007() Dim SourceRange As Range Set SourceRange = Sheets("Sheet1").Range("A3:N86") ActiveWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=SourceRange, _ Version:=xlPivotTableVersion12).CreatePivotTable _ TableDestination:="", _ TableName:="", _ DefaultVersion:=xlPivotTableVersion12 End Sub
14. Attach active workbook in an Email
My favorite VBA code. It lets you attach and send the file you’re working on with a predefined email address, message title, and message body! You first need to set reference to Microsoft Outlook (in your VBA editior, click on tools => references and choose Microsoft Outlook).
Sub SendFIleAsAttachment() 'Declare your variables 'Set reference to Microsoft Outlook Object library Dim OLApp As Outlook.Application Dim OLMail As Object 'Open Outlook start a new mail item Set OLApp = New Outlook.Application Set OLMail = OLApp.CreateItem(0) OLApp.Session.Logon 'Build your mail item and send With OLMail .To = "firstname.lastname@example.org; email@example.com" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add ActiveWorkbook.FullName .Display 'Change to .Send to send without reviewing End With 'Memory cleanup Set OLMail = Nothing Set OLApp = Nothing End Sub
15. Send all Excel charts to a PowerPoint presentation
A very handy macro that lets you add all your Excel charts in your Powerpoint presentation just with a single click:
Sub SendExcelFiguresToPowerPoint() 'Set reference to Microsoft Powerpoint Object Library 'Declare your variables Dim PP As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim i As Integer 'Check for charts; exit if no charts exist Sheets("Slide Data").Select If ActiveSheet.ChartObjects.Count < 1 Then MsgBox "No charts existing the active sheet" Exit Sub End If 'Open PowerPoint and create new presentation Set PP = New PowerPoint.Application Set PPPres = PP.Presentations.Add PP.Visible = True 'Start the loop based on chart count For i = 1 To ActiveSheet.ChartObjects.Count 'Copy the chart as a picture ActiveSheet.ChartObjects(i).Chart.CopyPicture _ Size:=xlScreen, Format:=xlPicture Application.Wait (Now + TimeValue("0:00:1")) 'Count slides and add new slide as next available slide number ppSlideCount = PPPres.Slides.Count Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank) PPSlide.Select 'Paste the picture and adjust its position; Go to next chart PPSlide.Shapes.Paste.Select PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True Next i 'Memory Cleanup Set PPSlide = Nothing Set PPPres = Nothing Set PP = Nothing End Sub
16. Send Excel table in MS Word
Excel tables are usually put inside text documents. Here is an automated way of exporting your Excel table to MS Word:
Sub ExcelTableInWord() 'Set reference to Microsoft Word Object library 'Declare your variables Dim MyRange As Excel.Range Dim wd As Word.Application Dim wdDoc As Word.Document Dim WdRange As Word.Range 'Copy the defined range Sheets("Revenue Table").Range("B4:F10").Cop 'Open the target Word document Set wd = New Word.Application Set wdDoc = wd.Documents.Open _ (ThisWorkbook.Path & "\" & "PasteTable.docx") wd.Visible = True 'Set focus on the target bookmark Set WdRange = wdDoc.Bookmarks("DataTableHere").Rangе 'Delete the old table and paste new On Error Resume Next WdRange.Tables(1).Delete WdRange.Paste 'paste in the table 'Adjust column widths WdRange.Tables(1).Columns.SetWidth _ (MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth 'Reinsert the bookmark wdDoc.Bookmarks.Add "DataTableHere", WdRange 'Memory cleanup Set wd = Nothing Set wdDoc = Nothing Set WdRange = Nothing End Sub
17. Extract a specific word from a cell
We can use formulas if we want to extract certain number of symbols. But what if we want to extract only the second word from a sentence or a range of words in a cell? To do this, we can create a custom Excel function with VBA. This is one of the most iportant VBA functionalities, because it lets you create your own functions that are non-existent in MS Excel. Let’s go on and create two functions: findword() and findwordrev(). Here’s the vba code for this:
Function FindWord(Source As String, Position As Integer) As String On Error Resume Next FindWord = Split(WorksheetFunction.Trim(Source), " ")(Position - 1) On Error GoTo 0 End Function Function FindWordRev(Source As String, Position As Integer) As String Dim Arr() As String Arr = VBA.Split(WorksheetFunction.Trim(Source), " ") On Error Resume Next FindWordRev = Arr(UBound(Arr) - Position + 1) On Error GoTo 0 End Function
Very nice, we have created two cstom Excel functions. Now, try to use them in Excel. The function = FindWordRev (A1,1) takes the last word from cell A1. The function = FindWord (A1,3) takes the third word from cell A1, etc.
18. Protect your Workbook
Sometimes we want to protect the data in our file so that only we can change it. Here’s how to do this with VBA:
Sub ProtectSheets() 'Declare your variables Dim ws As Worksheet 'Start looping through all worksheets For Each ws In ActiveWorkbook.Worksheets 'Protect and loop to next worksheet ws.Protect Password:="1234" Next ws End Sub
Congratulations! Since you are still reading this, you are really keen on learning VBA. As you have already seen for yourself, the VBA programming language is extremely useful and can save us a lot of time. I hope you found this information helpful and use it to become a master in MS Excel, VBA and computer software in general.
© 2017 Atanas Yonkov