Solved

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

Posted on 2015-01-15
15
185 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 5

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
 
LVL 85

Expert Comment

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

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 5

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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 5

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 5

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 5

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
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…

948 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

18 Experts available now in Live!

Get 1:1 Help Now