Pages

Saturday, April 19, 2014

Print All Formula’s used in a workbook

Macro to print all formula's used in a workbook. Snapshot below -
















Code -

 Sub all_formulas()
    Dim extlinks
    Dim j As Long, k As Long
    Dim wkb As Workbook
    Dim rng As Range, cl As Range
    Dim links1 As String
    Dim wk As Worksheet
    Set wkb = Workbooks.Add
    wkb.Sheets(1).Range("a1").Value = "Sheet Name"
    wkb.Sheets(1).Range("b1").Value = "Cell Address"
    wkb.Sheets(1).Range("c1").Value = "Formula"
    wkb.Sheets(1).Range("d1").Value = "Value"
    wkb.Sheets(1).Range("e1").Value = "External Link"
    wkb.Sheets(1).Range("f1").Value = "Formula length"
    k = 2
    extlinks = ThisWorkbook.LinkSources(xlExcelLinks)
    
    For Each wk In ThisWorkbook.Sheets
        On Error Resume Next
        Set rng = wk.UsedRange.SpecialCells(xlCellTypeFormulas)
        
            If Not rng Is Nothing Then
                For Each cl In rng
                    wkb.Sheets(1).Range("a" & k).Value = wk.Name
                    wkb.Sheets(1).Range("b" & k).Value = cl.Address
                    wkb.Sheets(1).Range("c" & k).Value = "'" & cl.Formula
                    wkb.Sheets(1).Range("d" & k).Value = cl.Text
                    For j = LBound(extlinks) To UBound(extlinks)
                        links1 = Left(extlinks(j), InStrRev(extlinks(j), "\")) & "[" & Right(extlinks(j), Len(extlinks(j)) - InStrRev(extlinks(j), "\"))
                        If InStr(" " & cl.Formula, links1) > 0 Then
                            wkb.Sheets(1).Range("e" & k).Value = extlinks(j)
                            Exit For
                        End If
                    Next
                    wkb.Sheets(1).Range("f" & k).Value = Len(cl.Formula)
                    k = k + 1
                Next
            
        End If
        Set rng = Nothing
    Next
End Sub

No comments:

Post a Comment