Solved

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

Posted on 2015-01-15
15
188 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
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 
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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

813 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now