Solved

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

Posted on 2015-01-15
15
194 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

696 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