Extract all formulas from excel - Word и Excel - помощь в работе с программами

Hello and welcome to MrExcel.

If you press CTRL + ` the formulas will be displayed. CTRL + ` again to revert to the normal display.

Hi,

To extract all formulas,

Code:

Sub kTest()
Dim r As Range, c As Range, w(), n As Long, ws As Worksheet

Set r = Nothing
On Error Resume Next
Set r = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not r Is Nothing Then
    For Each c In r
        n = n + 1
        ReDim Preserve w(1 To n)
        w(n) = c.Formula
    Next
    On Error Resume Next
    Set ws = Sheets("ListFormulas")
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Sheets.Add: ws.Name = "ListFormulas"
    End If
    With ws.Range("a1")
        .Value = "Formulas"
        .Offset(1).Resize(n).NumberFormat = "@"
        .Offset(1).Resize(n).Value = Application.Transpose(w)
    End With
End If
End Sub

HTH

Hi thanks for this, please tell me where the output for this would be…I am not familiar with Excel and am a Java developer. Any help would be appreciated,

Hi,

To extract all formulas,
Code:
Sub kTest()
Dim r As Range, c As Range, w(), n As Long, ws As Worksheet

Set r = Nothing
On Error Resume Next
Set r = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not r Is Nothing Then
    For Each c In r
        n = n + 1
        ReDim Preserve w(1 To n)
        w(n) = c.Formula
    Next
    On Error Resume Next
    Set ws = Sheets("ListFormulas")
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Sheets.Add: ws.Name = "ListFormulas"
    End If
    With ws.Range("a1")
        .Value = "Formulas"
        .Offset(1).Resize(n).NumberFormat = "@"
        .Offset(1).Resize(n).Value = Application.Transpose(w)
    End With
End If
End Sub
HTH

Hi thanks for this, please tell me where the output for this would be…I am not familiar with Excel and am a Java developer. Any help would be appreciated,

Hit Alt+F11 > Goto Insert > Module and paste the code there.
Close VBE window (Alt+Q) > Goto Tools > Macro > Macros and run kTest.

Thanks for the update, is possible to filter by a String for the function name. For example if I wanted to extract all formulas for all sheets where the formula had a name starting with testFunction?

Thanks again
[/FONT]

If you are able to give me a very brief summary of the variables and functions in this code I can prob write this myself. Coming from a Java role this is foreign to me — any guidance on the kTest() would be appreciated,

Hi,

I think it needs some REGULAR EXPRESSION coding to get all the formula names. I hope pgc01 or Jindon or Richard might help you if they follow this thread.

Источник

Sub X()
' constants
Const ksDot = "."
Const ksDoc = "_doc"
Const ksXLSX = "xlsx"
' declarations
Dim I As Integer, J As Integer, K As Integer, L As Integer
Dim iRows As Integer, iColumns As Integer
Dim sName As String, sFileName As String
Dim sNewName As String, sNewFileName As String
' start
'  source workbook
With ActiveWorkbook
sName = .Name
sFileName = .FullName
I = InStr(StrReverse(sName), ksDot)
sNewFileName = Left$(sName, _
Len(sName) - I - 1) & ksDoc & ksDot & ksXLSX
I = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = .Worksheets.Count
End With
'  delete
If Dir(sNewFileName, vbNormal) <> "" Then Kill sNewFileName
'  add
Workbooks.Add
Application.SheetsInNewWorkbook = I
With ActiveWorkbook
.SaveAs sNewFileName
sNewName = .Name
End With
Workbooks(sName).Activate
' process
With ActiveWorkbook
For I = 1 To .Worksheets.Count
' format
Workbooks(sNewName).Worksheets(I).Cells.NumberFormat = "@"
' name
Workbooks(sNewName).Worksheets(I).Name = .Worksheets(I).Name
' formulas
With .Worksheets(I)
With .UsedRange
iRows = .Rows.Count
iColumns = .Columns.Count
End With
For K = 1 To iRows
For J = 1 To iColumns
Workbooks(sNewName).Worksheets(I).Cells(K, J).Value = .Cells(K, J).Formula
Next J
Next K
End With
Next I
End With
' end
End Sub

Источник

I had a spreadsheet in Excel 2007. (I suspect the approach used here would also work in other versions of Excel, but I have not tried it.) I wanted to print out the formulas used in each cell. I did a couple of searches and wound up in a thread where they have advised me to create a module for the same. To add a new module to your excel file press Alt + F11. Following is the code that I used to get the list of all the formulas used in the excel file.

Sub ListFormulas()

‘ constants
Const ksDot = “.”
Const ksDoc = “_formula_doc”
Const ksXLSX = “xlsx”

‘ declarations
Dim I As Integer, J As Integer, K As Integer
Dim L As Integer
Dim iRows As Integer, iColumns As Integer
Dim sName As String, sFileName As String
Dim sNewName As String, sNewFileName As String
Dim sCellName As String

‘ start
‘ source workbook
With ActiveWorkbook
sName = .Name
sFileName = .FullName
I = InStr(StrReverse(sName), ksDot)
sNewFileName = Left$(sName, _
Len(sName) – I – 1) & ksDoc &
ksDot & ksXLSX
I = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = .Worksheets.Count
End With

‘ delete
If Dir(sNewFileName, vbNormal) <> “”
Then Kill sNewFileName

‘ add
Workbooks.Add
Application.SheetsInNewWorkbook = I
With ActiveWorkbook
.SaveAs sNewFileName
sNewName = .Name
End With
Workbooks(sName).Activate

‘ process
With ActiveWorkbook
For I = 1 To .Worksheets.Count
‘ format
Workbooks(sNewName).Worksheets(I).Cells.NumberFormat
= “@”
‘ name
Workbooks(sNewName).Worksheets(I).Name =
.Worksheets(I).Name
‘ formulas
With .Worksheets(I)
With .UsedRange
iRows = .Rows.Count
iColumns = .Columns.Count
End With
For K = 1 To iRows
For J = 1 To iColumns
If .Cells(K, J).HasFormula Then
sCellName = .Cells(K, J).Address
Else
sCellName = “”
End If
Workbooks(sNewName).Worksheets(I).Cells(K, J).Value =
sCellName + .Cells(K, J).Formula

Next J
Next K
End With
Next I
End With
‘ end

End Sub

Источник

Described is a convenient method for using VBA scripts to extract every formula from a Microsoft Excel workbook and create a list of them in a separate sheet for later reference or backup.

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.

Important prerequisites

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).

The process

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; ListAllFormulae and 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: Workbooks(2).Close SaveChanges:=False

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.

Insert 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:

A summary of every formula contained in the “Source-of-Formulae” workbook.

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!

Have Your Say

Источник

Excel formula extractor

What it will do for you

Did you ever inherit a project from a colleague where all calculations were done in Excel?
However, for reproducibility and version control reasons, you would prefer to use a programming language such as R…
This project can help you!

The script will extract all formulas defined in an Excel sheet into an R script.
It will use the defined variable names in the Excel sheet (if available).
- If no names were defined, it will try to guess the names by accessing the cell left to a certain formula.
- If no variable name can be guessed, it will create generic variable names.
It will figure out the ordering in which the calculations have to be executed.
- Still, it will try to keep variables defined in one sheet together.
It will transform calls to VLOOKUP/HLOOKUP (in German: «SVERWEIS», «WVERWEIS») into calls applicable in R.
- All data contained in LOOKUP tables will be written to separate csv files.
- In the beginning of the automatically created script, all the referenced lookup tables will be read in.
It can be adapted to your needs by adapting the function functionTransformer to handle other functions than VLOOKUP/HLOOKUP. E.g., you can adapt it to transform IF to ifelse function calls, etc.

How To…

Configure the script excel-export.R in the block #### Settings ####. Then, run it via the source command. If you use the standard configuration… * the file script-out/script.R will be created containing the formulas from excel-in/calculations.xlsx.
- a log of messages will be written to script-out/log.txt.
- After each script line (variable definition and calculation), there will be a script comment containing the cell where the calculation was found, the content of the cells to the left and right, as well as the content of a comment (if there was any for this cell).
If you alter the automatically created script (from Excel) in the future, assure that it does not contain circular references using the function findCircularReferences(filename).

The output for the given Excel sheet will be as follows:

#### pre script block ####

tryNum <- function (x) 
{
    if (is.numeric(x)) 
        return(x)
    out <- suppressWarnings(as.numeric(x))
    if (is.na(out)) 
        return(x)
    return(out)
}

V_calculations1_I6_L10 <- read.table("script-out/V_calculations1_I6_L10.csv", sep=";", header=FALSE, row.names = 1, stringsAsFactors=FALSE, quote = """, comment.char="", na.strings=c(""))
H_calculations1_I6_L10 <- read.table("script-out/H_calculations1_I6_L10.csv", sep=";", header=TRUE, stringsAsFactors=FALSE, quote = """, comment.char="", na.strings=c(""))
V_calculations1_I13_L17 <- read.table("script-out/V_calculations1_I13_L17.csv", sep=";", header=FALSE, row.names = 1, stringsAsFactors=FALSE, quote = """, comment.char="", na.strings=c(""))

#### Script ####

# b
w = 4 # b!C5 | b.w | w | is defined as w

# calculations2
e = 1 # calculations2!C2 |  | e | is defined as e
f = 2 # calculations2!C3 |  | f | is defined as f

# calculations1
b = 1 # calculations1!C3 |  | b | is defined as b
d = 4 # calculations1!C5 |  | d | is defined as d
j = 10 # calculations1!C11 |  |  | is defined as j
r_ = "h" # calculations1!C21 |  | r_ | variable for VLOOKUP
VAR_2 = 10 # calculations1!C8 |  |  | should become VAR_
VAR_5 = 10 # calculations1!C11 |  |  | is defined as j
u = tryNum(V_calculations1_I6_L10["a", 1]) # calculations1!C17 |  | u | VLOOKUP / SVERWEIS
u2 = tryNum(V_calculations1_I6_L10["a", 1]) # calculations1!C18 |  | u2 | VLOOKUP / SVERWEIS (duplicate)
t = tryNum(H_calculations1_I6_L10[1,"X3"]) # calculations1!C19 |  | t | HLOOKUP / WVERWEIS
c_ = d+1 # calculations1!C4 |  | c_ | is defined as c_
i = VAR_2+1 # calculations1!C10 |  |  | is defined as i
s = tryNum(V_calculations1_I13_L17[r_, 1]) # calculations1!C20 |  | s | VLOOKUP / SVERWEIS - using variable
a = ifelse(b<10,b+c_,0) # calculations1!C2 | calculations1.a | a | is defined as a
VAR_6 = i+1 # calculations1!C13 |  |  | should become VAR_
VAR_8 = i+1 # calculations1!C14 |  |  | should become VAR_
VAR_9 = i+1 # calculations1!C15 |  |  | should become VAR_

# calculations1, calculations2
g = e+f+a # calculations2!C4 |  | g | is defined as g
h = e+f+a # calculations2!C5 |  | h | is defined as h
z_ = h+1 # calculations2!C6 | calculations2.z_ | z_ | is defined as z_
x = z_+1 # calculations1!C6 | calculations1.x | x | is defined as x

# a, b, calculations1, calculations2
y = x+z_+w # a!C5 | a.y | y | final value

Источник