VBA: List all formulae in an Excel workbook
I spend a lot of time using shared Microsoft Excel worksheets in the workplace. I have become quite proficient at writing lengthy equations to complete complicated calculations, but occasionally things go awry. Only one person needs to go into a spreadsheet and overwrite a cell and something could break.
That’s why I have compiled the following script: to ‘back-up’ my equations and store them in a safe place in case I need to restore my work.
How it works
This script will complete the following general tasks:
- Using a dialogue box, ask the user to select a file from which to extract all formulae
- Open the selected file, then scan every sheet for formulae
- Compile those formulae in lists within new temporary worksheets
- Transfer those worksheets, compile them into a single sheet and delete the temporary sheets
- Number each equation and prompt the user to save the sheet somewhere.
It is important that the only Excel workbook that’s open is the one that contains the VBA script. This script can extract formulae from multiple sheets but only one workbook at a time.
The script also assumes that data is linearised or stored in a matrix with headers in Row 1 and formulae in Row 2 that are consistent for the length of the table (this represents best practice). Therefore it only scans Row 2 and odd formulae in other locations will be missed. (This can be changed but will considerably slow the script).
In order to get this to work, I assembled the script from a series of smaller sub-scripts:
1. Open a workbook
The workbook that contains the VBA script is called “Formulae_Extractor.xlsm”.
We must commence by opening the workbook that contains the formulae that we wish to extract. The following script triggers an open file dialogue box to enable the user to choose the file. If no file is selected, a dialogue box appears stating “No file selected”.
Sub OpenSheets() 'Opens a file selection dialogue box Dim sImportFile As String, sFile As String Dim sThisBk As Workbook Dim vfilename As Variant Application.ScreenUpdating = False Application.DisplayAlerts = False Set sThisBk = ActiveWorkbook sImportFile = Application.GetOpenFilename( _ fileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook") If sImportFile = "False" Then MsgBox "No file selected" End 'was Exit Sub Else vfilename = Split(sImportFile, "\") sFile = vfilename(UBound(vfilename)) Application.Workbooks.Open Filename:=sImportFile, ReadOnly:=True End If Application.ScreenUpdating = False Application.DisplayAlerts = False End Sub
2. Create the loop
In order to function, Visual Basic for Applications needs to loop through every worksheet in the chosen Excel file and extract the formulae from each. Here’s how I set-up my loop:
Sub LoopSheets() 'Loops through the worksheets Dim wbk As Workbook, rngToCopy As Range, rngToPaste As Range For Each wbk In Workbooks If wbk.Name <> ThisWorkbook.Name Then 'Excludes the workbook that hosts the script from the loop End If Next 'Activate the workbook containing the formulae Workbooks(2).Activate 'Run the script that lists all formulae ListAllFormulae 'Activate the other workbook For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then x = wb.Name Next wb Workbooks(x).Activate 'Run the script that transfers the formula sheets MoveWorksheets End Sub
You will notice that this sub references two other scripts;
MoveWorksheets. These are detailed later on, but need to be included in this loop for the process to function.
3. List all of the formulae
In order to achieve this, I modified a brilliant script written by Debra Dalgleish which looks through a workbook, extracts all of the formulae and places them into a series of new sheets called “F_(name of original sheet)”.
I adjusted the script so that it only passed through Row 2 for two reasons:
- The script will run faster through large workbooks.
- When data is “formatted as table” and displayed in a linearised format or as a matrix, Row 2 should contain every formula on the sheet.
Sub ListAllFormulae() 'Modified from http://blog.contextures.com/archives/2012/09/27/list-all-formulas-in-workbook/ Dim lRow As Long Dim wb As Workbook Dim ws As Worksheet Dim wsNew As Worksheet Dim c As Range Dim rngF As Range Dim strNew As String Dim strSh As String On Error Resume Next Application.DisplayAlerts = False Set wb = ActiveWorkbook strSh = "F_" For Each ws In wb.Worksheets lRow = 2 If Left(ws.Name, Len(strSh)) <> strSh Then Set rngF = Nothing On Error Resume Next Set rngF = ws.Rows(2).Cells.SpecialCells(xlCellTypeFormulas, 23) If Not rngF Is Nothing Then strNew = Left(strSh & ws.Name, 30) Worksheets(strNew).Delete Set wsNew = Worksheets.Add With wsNew .Name = strNew .Columns("A:F").NumberFormat = "@" 'text format .Range(.Cells(1, 1), .Cells(1, 6)).Value _ = Array("ID", "Workbook", "Sheet", "Cell", "Formula A1", "Formula R1C1") For Each c In rngF .Range(.Cells(lRow, 1), .Cells(lRow, 6)).Value _ = Array(lRow - 1, wb.Name, ws.Name, c.Address(0, 0), _ c.Formula, c.FormulaR1C1) lRow = lRow + 1 Next c .Rows(1).Font.Bold = True .Columns("A:F").EntireColumn.AutoFit End With 'wsNew Set wsNew = Nothing End If End If Next ws Application.DisplayAlerts = True End Sub
4. Move the formula sheets
The second sub in the loop moves all of the individual sheets that are created through Debra Dalgleish’s script from the file containing the formulae to Formulae_Extractor.xlsm:
Sub MoveWorksheets() 'Moves worksheets to Formulae_Extractor.xlsm Dim ws As Worksheet Application.DisplayAlerts = False For Each sh In Workbooks(2).Worksheets If sh.Name Like "F_*" Then sh.Move Before:=Workbooks("Formulae_Extractor.xlsm").Sheets(1) End If Next Application.DisplayAlerts = True End Sub
5. Combine the formula sheets into one
The next step was to combine the different formula sheets into one long sheet for convenience. To do this, I modified a script by Allen Wyatt which was written for that very purpose.
Sub Combine() 'Modified from http://excel.tips.net/T003005_Condensing_Multiple_Worksheets_Into_One.html Dim J As Integer On Error Resume Next Sheets(1).Select Worksheets.Add ' add a sheet in first place Sheets(1).Name = "Formulae" ' copy headings Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") ' work through sheets For J = 2 To Sheets.Count - 1 ' from sheet 2 to second last sheet Sheets(J).Activate ' make the sheet active Range("A1").Select Selection.CurrentRegion.Select ' select all cells in this sheets ' select all lines except title Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select ' copy cells selected in the new sheet on last line Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next End Sub
Allen Wyatt advises that this script may not work in Excel 2007/2010/2013 but it worked fine for me in Excel 2010. If you encounter problems, consider using this version instead.
6. Delete the individual formula sheets
Next I wanted to delete all of those individual formula sheets. I used a
Worksheets(1).Activate script to activate the correct workbook and then ran a sub designed to delete all of those unwanted sheets. Because their names all start with “F_”, they were easy to target.
Sub DeleteFormulaSheets() 'Deletes all sheets with formulas in them Dim ws2 As Worksheet Application.DisplayAlerts = False For Each sh In Workbooks("Formulae_Extractor.xlsm").Worksheets If sh.Name Like "F_*" Then sh.Delete End If Next Application.DisplayAlerts = True End Sub
7. Fix the ID numbering problem
Debra Dalgleish’s script inserts a column called “ID” on the left of the formula sheets and numbers them sequentially. Although nice, the sequence of numbers is destroyed when multiple formula sheets are combined. This script starts the numbering from 1 and continues down every row that has data in it, thus restoring sequential numbering.
Sub NumberRows() 'Removes the "Number stored as text" error throughout the sheet Application.ErrorCheckingOptions.NumberAsText = False 'Starts the numbering at 1 Worksheets("Formulae").Range("A2").Activate Range("A2").Value = "1" 'Activates cell A2 in Formulae sheet Worksheets("Formulae").Range("A2").Activate 'Numbers each row sequentially Dim lastrow As Long lastrow = Worksheets("Formulae").Range("A2").End(xlDown).Row With Worksheets("Formulae").Range("A2") .AutoFill Destination:=Range("A2:A" & lastrow&) End With End Sub
8. Clean up the mess
My next step was to insert two more columns that I felt would be useful. Because I work in a shared environment, I wanted to know:
- Which person compiled the list of formulae
- The time that the script was run
I also wanted to tidy the sheet by adjusting the column widths. This script adds those two columns and then does the “clean up”. Part of this sub utilises code written by “Von Pookie“.
Sub Cleanup() 'Insert two columns Range("B:C").EntireColumn.Insert [B1].Value = "UserID" [C1].Value = "Date" Range("B2:B2").Select ActiveCell.FormulaR1C1 = Environ("username") Range("C2:C2").Select ActiveCell.Value = Format(Now(), "dd-MM-yyyy") 'Capture the last row 'From http://www.mrexcel.com/forum/excel-questions/80436-problem-incrementing-autofill-visual-basic-applications.html#post391152 Dim myLastRow As Long myLastRow = Range("A65536").End(xlUp).Row 'Autofill columns B & C Columns("B:C").NumberFormat = "@" Range("B2").FormulaR1C1 = Environ("username") Range("B2:B" & myLastRow).FillDown Range("C2").FormulaR1C1 = Format(Now, "dd/mm/yyyy hh:mm:ss") Range("C2:C" & myLastRow).FillDown 'Fix column widths so it looks pretty Columns("A:B").ColumnWidth = 6 Columns("C").ColumnWidth = 20 Columns("D").ColumnWidth = 50 Columns("E").ColumnWidth = 30 Columns("F").ColumnWidth = 6 Columns("G:H").ColumnWidth = 70 End Sub
9. Prompt the user to save the sheet
Once the sheet containing the complete list of formulae had been cleaned-up, I wanted Excel to prompt the user to save the sheet in a new workbook (and not as part of “Formulae_Extractor.xlsm”). Here’s how this is achieved:
Sub SaveSheet() 'Directs a prompt for saving the formulae sheet Sheets("Formulae").Copy Application.DisplayAlerts = False Workbooks("Formulae_Extractor.xlsm").Sheets("Formulae").Delete Application.DisplayAlerts = True Dim IntialName As String Dim fileSaveName As Variant InitialName = Format(Now, "yyyymmdd") & "_" "Formulae_from_" & Range("D2") fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _ fileFilter:="Excel Files (*.xlsx), *.xlsx") If fileSaveName <> False Then MsgBox "Save as " & fileSaveName End If End Sub
You will notice that the suggested file name is “YYYYMMDD_Formulae_from_(name of source sheet).xlsx”, but this can be changed. Importantly, if the user declines the offer to save the sheet in a new workbook, they’ll still be able to see their formulae in “Book2”.
The final step is to run another bit of code to close the workbook that contained the formulae originally:
10. Stitching it all together
Because I am running a series of subs, I inserted them into a “master” script as follows:
'Excel formulae extractor 'Written by Adam Dimech - http://www.adonline.id.au/ Sub FormulaeExtract() OpenSheets LoopSheets Combine Worksheets(1).Activate DeleteFormulaSheets NumberRows Cleanup SaveSheet Workbooks(2).Close SaveChanges:=False End Sub
Implimentation and output
This script (along with the other subs) are simply inserted into a module for “Formulae_Extractor.xlsm” within Visual Basic for Applications. Instructions for this are available here.
FormulaeExtract first, then the others either into the same module or separately (it doesn’t matter).
In “Formulae_Extractor.xlsm”, insert a button to trigger the
FormulaeExtract script. Go to Developer > Insert > Button (Form Control), then select “FormulaeExtract”.
The final output should look something like this:
Now in order to record all of the formulae contained in a Microsoft Excel workbook, a user needs only open “Formulae_Extractor.xlsm”, click the “start” button to activate
FormulaeExtract and wait a few seconds to receive their list. Easy!