Solved

Excel VBA to list all of the workbook formulas in a seperate sheet

Posted on 2015-01-15
15
189 Views
Last Modified: 2015-01-15
Hello,

i need help with VBA code that lists all of the activeworkbook formulas into a new sheet


thanks.
0
Comment
Question by:Flora
  • 8
  • 6
15 Comments
 
LVL 2

Expert Comment

by:Pratik Makwana
ID: 40550937
Below Macro Copy all formula of Sheet1 to Sheet2 in same cells....
Sub FormulaCopy()
Dim rng As Range, Dest, Source As String
For Each rng In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeFormulas)
    Dest = rng.Address
    Source = rng.Formula
    Sheets("Sheet2").Range(Dest).Formula = Source
Next
End Sub

Open in new window

0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40550947
What exactly do you want as the output - a list of all the distinct formulas, or just every formula? Is that all the information you want?
0
 
LVL 6

Author Comment

by:Flora
ID: 40550990
Thanks Rory,

i want all formulas.  

i had found this code in internet from Jonhn Walkenbatch but it is too slow, it freezes, i wanted a faster one. becuase the excel sheet that i am trying to extract its formulas in another sheet as text, is heavily populated with too many formuals.

Sub ListFormulas()
    Dim FormulaCells As Range, Cell As Range
    Dim FormulaSheet As Worksheet
    Dim Row As Integer
    
'   Create a Range object for all formula cells
    On Error Resume Next
    Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
    
'   Exit if no formulas are found
    If FormulaCells Is Nothing Then
        MsgBox "No Formulas."
        Exit Sub
    End If
    
'   Add a new worksheet
    Application.ScreenUpdating = False
    Set FormulaSheet = ActiveWorkbook.Worksheets.Add
    FormulaSheet.Name = "Formulas in " & FormulaCells.Parent.Name
    

'   Set up the column headings
    With FormulaSheet
        Range("A1") = "Address"
        Range("B1") = "Formula"
        Range("C1") = "Value"

        Range("A1:C1").Font.Bold = True
    End With
    
'   Process each formula
    Row = 2
    For Each Cell In FormulaCells
        Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
        With FormulaSheet
            Cells(Row, 1) = Cell.Address _
                (RowAbsolute:=False, ColumnAbsolute:=False)
            Cells(Row, 2) = " " & Cell.Formula
            Cells(Row, 3) = Cell.Value
            Row = Row + 1
        End With
    Next Cell
    
'   Adjust column widths
    FormulaSheet.Columns("A:C").AutoFit
    Application.StatusBar = False
End Sub

Open in new window

0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40551061
So you only want the formulas and not the location?
0
 
LVL 6

Author Comment

by:Flora
ID: 40551095
i want in first column of new sheet,  Formula that is stored with ' Apostrophe as text and then next column the cell/sheet location address of the formula. that is it.
0
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
ID: 40551159
Try this:

Sub ListFormulas()
    Dim ws                    As Worksheet
    Dim FormulaCells          As Range
    Dim Cell                  As Range
    Dim FormulaSheet          As Worksheet
    Dim lRow                  As Long
    Dim dic                   As Object
    Dim vFormulas             As Variant

    Application.ScreenUpdating = False

    lRow = 2

    Set dic = CreateObject("Scripting.Dictionary")


    For Each ws In ActiveWorkbook.Worksheets

        '   Create a Range object for all formula cells
        On Error Resume Next
        Set FormulaCells = ws.UsedRange.SpecialCells(xlFormulas)
        On Error GoTo 0
        '   Exit if no formulas are found
        If Not FormulaCells Is Nothing Then


            '   Process each formula
            For Each Cell In FormulaCells
                dic.Add ws.Name & "!" & Cell.Address(0, 0), "'" & Cell.Formula
            Next Cell
        End If
    Next ws

    If dic.Count <> 0 Then
        '   Add a new worksheet
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("Formula list").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Set FormulaSheet = ActiveWorkbook.Worksheets.Add
        FormulaSheet.Name = "Formula list"

        '   Set up the column headings
        FormulaSheet.Range("A1:B1") = Array("Address", Formula)
        vFormulas = Application.Index(Array(dic.keys, dic.items), 0, 0)
        FormulaSheet.Range("A2").Resize(UBound(vFormulas, 2), UBound(vFormulas, 1)).Value = Application.Transpose(vFormulas)
        '   Adjust column widths
        FormulaSheet.Columns("A:B").AutoFit
    End If
End Sub

Open in new window

0
 
LVL 6

Author Comment

by:Flora
ID: 40551222
thanks Rory,

but the debugger stopped at line 46 vFormulas = Application.Index(Array(dic.keys, dic.items), 0, 0)
vFormulas = Application.Index(Array(dic.keys, dic.items), 0, 0)

Open in new window

0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40551290
Roughly how many formulas are you dealing with - more than 65000?
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40551317
If you have up to 65000 odd formulas on any one sheet, you can use this version:

Sub ListFormulas()
    Dim ws                    As Worksheet
    Dim FormulaCells          As Range
    Dim Cell                  As Range
    Dim FormulaSheet          As Worksheet
    Dim lRow                  As Long
    Dim dic                   As Object
    Dim vFormulas             As Variant

    Application.ScreenUpdating = False

    lRow = 2

    Set dic = CreateObject("Scripting.Dictionary")


    '   Add a new worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Formula list").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set FormulaSheet = ActiveWorkbook.Worksheets.Add
    FormulaSheet.Name = "Formula list"

    '   Set up the column headings
    FormulaSheet.Range("A1:B1") = Array("Address", Formula)
    For Each ws In ActiveWorkbook.Worksheets

        '   Create a Range object for all formula cells
        On Error Resume Next
        Set FormulaCells = ws.UsedRange.SpecialCells(xlFormulas)
        On Error GoTo 0
        '   Exit if no formulas are found
        If Not FormulaCells Is Nothing Then


            '   Process each formula
            For Each Cell In FormulaCells
                dic.Add ws.Name & "!" & Cell.Address(0, 0), "'" & Cell.Formula
            Next Cell

        End If

        If dic.Count <> 0 Then
            vFormulas = Application.Index(Array(dic.keys, dic.items), 0, 0)
            FormulaSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(vFormulas, 2), UBound(vFormulas, 1)).Value = Application.Transpose(vFormulas)
            '   Adjust column widths
        End If
        dic.RemoveAll
        Set FormulaCells = Nothing
    Next ws
    FormulaSheet.Columns("A:B").AutoFit
End Sub

Open in new window

0
 
LVL 6

Author Comment

by:Flora
ID: 40551359
yes, Rory. the formulas are couple of thousands

the latest code stopped at line 46  error 13
type mismatch
code             vFormulas = Application.Index(Array(dic.keys, dic.items), 0, 0)
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40551378
Any chance you can post the workbook so I can see what's going on?
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40551395
Third version for testing in the meantime:

Sub ListFormulas()
    Dim ws                    As Worksheet
    Dim FormulaCells          As Range
    Dim Cell                  As Range
    Dim FormulaSheet          As Worksheet
    Dim dic                   As Object

    Application.ScreenUpdating = False

    Set dic = CreateObject("Scripting.Dictionary")


    '   Add a new worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Formula list").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set FormulaSheet = ActiveWorkbook.Worksheets.Add
    FormulaSheet.Name = "Formula list"

    '   Set up the column headings
    FormulaSheet.Range("A1:B1") = Array("Formula", "Address")
    For Each ws In ActiveWorkbook.Worksheets

        '   Create a Range object for all formula cells
        On Error Resume Next
        Set FormulaCells = ws.UsedRange.SpecialCells(xlFormulas)
        On Error GoTo 0
        '   Exit if no formulas are found
        If Not FormulaCells Is Nothing Then


            '   Process each formula
            For Each Cell In FormulaCells
                dic.Add ws.Name & "!" & Cell.Address(0, 0), "'" & Cell.Formula
            Next Cell

        End If

        If dic.Count <> 0 Then
            With FormulaSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count, 1)
                .Value = Application.Transpose(dic.items)
                .Offset(, 1).Value = Application.Transpose(dic.keys)
            End With
            '   Adjust column widths
        End If
        dic.RemoveAll
        Set FormulaCells = Nothing
    Next ws
    FormulaSheet.Columns("A:B").AutoFit
End Sub

Open in new window

0
 
LVL 6

Author Comment

by:Flora
ID: 40551449
Thanks Rory,

same mismatch error now this time at line 43                 .Value = Application.Transpose(dic.items)

sorry, i wish i could share the workbook here , A) it is too big to upload, B) it has some private company employee names etc as data which i am not allowed to share.
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 40551532
Do you have any really long formulas? What does dic.count return when the code breaks?
0
 
LVL 6

Author Comment

by:Flora
ID: 40552064
the return is nothing, all I get is a new sheet with the A1 cell "Address"  that is it. I do not see anything else.

by the way,  if this is too much, I will try to break the data into 4 or 5 piece and then run your first code.

your first code already helped me.

so, I do not want cause trouble for you.  I like you very much, as you have helped me many times.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question