18 ready-to-use VBA Codes that will save your day

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 macro

In 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

This code will highlight the top ten values from a selection of cells:

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 = "admin@datapigtechnologies.com; mike@datapigtechnologies.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.

Atanas Yonkov Blogger, Web Developer
yonkov.atanas@gmail.com