VBA (Visual Basic for Applications) is the programming language of Excel and other Office programs. With VBA you can automate tasks in Excel by writing so called macros, which can save you a ton of time. In this post, I have listed some of my most useful codes examples to help you become more productive in your day to day work.
1 – Insert a Table of Content (TOC)
The code below will insert a basic Table of Content (starting from the active cell), with a hyperlink to each sheet (se the picture below for an example). If you have a workbook with a ton of worksheets it could be a good idea to include a TOC on the first worksheet.
Option Explicit Public Sub InsertTOC() Dim i As Integer Dim s As Worksheet Dim r As Range Dim bOverride bOverride = False i = 0 For Each s In Sheets If Not bOverride And (ActiveCell.Offset(i, 0).Value <> "" Or ActiveCell.Offset(i, 1).Value <> "") Then If MsgBox("Cells are not EMPTY, do you want to override?", vbYesNo, "Override?") = vbNo Then Exit Sub End If bOverride = True End If ActiveCell.Offset(i, 0).Value = s.Name ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(i, 1), Address:="", SubAddress:= _ "'" + s.Name + "'!A1", TextToDisplay:="Goto sheet" ActiveCell.Offset(i, 0).Font.Size = 8 ActiveCell.Offset(i, 1).Font.Size = 8 i = i + 1 Next s End Sub
2 – Show hidden names
A workbook with hidden name ranges can prove to be a real headache as they do not show up in the Name Manager. You must unhide hidden name ranges with VBA. Copy and paste the script below into VBA, to unhide all hidden name ranges in the workbook.
Sub ShowAllNames() Dim n As Name For Each n In ThisWorkbook.Names If n.Visible = False Then n.Visible = True Next n End Sub
3 – Search your Workbook for Errors
Before you send an Excel Workbook to someone, it is a good practise to make sure the workbook does not include any errors (e.g. #N/A, #REF!, #NAME?, #DIV/0!, #NULL!, #VALUE! and #NUM!). With this code you can let Excel do this for you.
Option Explicit Sub List_Errors() Dim rErrors As Range, r As Range Dim i As Long, nr As Long Dim sName As String Application.ScreenUpdating = False 'Add Error sheet Sheets.Add Before:=Sheets(1) nr = 1 For i = 2 To Sheets.Count Set rErrors = Nothing On Error Resume Next Set rErrors = Sheets(i).UsedRange.SpecialCells(xlFormulas, xlErrors) On Error GoTo 0 If Not rErrors Is Nothing Then sName = Sheets(i).Name For Each r In rErrors nr = nr + 1 With Sheets(1) .Cells(nr, 1).Value = sName .Cells(nr, 2).Value = r.Address(0, 0) .Cells(nr, 3).Value = r.Text End With Next r End If Next i Sheets(1).Range("A1:C1").Value = Array("Sheet", "Cell", "Error") Application.ScreenUpdating = True End Sub
4 – Create a backup of the Workbook
This code will save a backup file of the current workbook in the same directory where your current file is saved. It will also include a timestamp in the name of the file.
Option Explicit Sub Backup() 'Create a backup of the workbook in the same folder with a timestamp ThisWorkbook.SaveCopyAs _ Filename:=ThisWorkbook.Path & "\" & _ Format(Now(), "yyyy-mm-dd HhNnSs") & " " & _ ThisWorkbook.Name End Sub
5 – Check the name of the user who is using an Excel or PowerPoint file
This code will search for the name of the user who has an Excel or PowerPoint file open. The script works with files located on your local PC as well as in a shared network folder.
Sub Button1_Click() 'This macro should be added to a button on a worksheet 'Go to the Developer ribbon tab and insert a button 'Add the full file path to the file you want to check to cell A1 on the same worksheet as the button 'The macro calls the method with the filepath to check (i.e. the one you have added to cell A1) GetUsedByUserName (ActiveSheet.Cells(1, 1)) End Sub 'This method checks if the file exists. If it does exist, it returns the name of the user who is using the file Sub GetUsedByUserName(FileToCheck As String) Dim objFSO As Object Dim f Dim i Dim x Dim UsedBy Dim tmpFile 'Make a temp file path to copy the original file's temp file tmpFile = Environ("TEMP") + "\tmpFile" + CStr(Int(Rnd * 1000)) Set objFSO = CreateObject("Scripting.FileSystemObject") If Not objFSO.FileExists(FileToCheck) Then MsgBox "The file does not exist", vbOKOnly, "not found" Exit Sub End If f = FreeFile 'get the index of the first occurrence of \ in the file path i = InStrRev(FileToCheck, "\") 'Append '~$' just before the file name If (i > 0) Then FileToCheck = Mid(FileToCheck, 1, i) + "~$" + Mid(FileToCheck, 1 + i) Else FileToCheck = "~$" + FileToCheck End If Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(FileToCheck) Then 'If the file exists fso.CopyFile FileToCheck, tmpFile 'copy that to the temp file path Open tmpFile For Binary Access Read As #f 'open the file in binary read mode Input #f, x Close (f) UsedBy = Mid(x, 2, Asc(x)) 'extract the user's name fso.Deletefile tmpFile 'delete the temp file Set fso = Nothing 'Return the user's name MsgBox "Used By This User: " + UsedBy, vbOKOnly, "Used By" Else 'Message if the file exists but is not in use MsgBox "The file is not in use", vbOKOnly, "no use" End If End Sub