Consulting

Results 1 to 3 of 3

Thread: List all formulas in a worksheet on a separate worksheet

  1. #1
    VBAX Contributor
    Joined
    Oct 2013
    Posts
    181
    Location

    List all formulas in a worksheet on a separate worksheet

    The code below works to copy formulas and cell addresses for an entire workbook. Can the code be modified to only copy formulas and addresses for a single worksheet with output to a specific (sheet3) worksheet as opposed to creating a new worksheet every time?

    I looked up Glaswegian the original author but they have not been logged in since 2016 so I don't think they are active.

    Any help would be appreciated.


    Sub ListAllFormulas()     
        Dim sht As Worksheet
        Dim shtName
        Dim myRng As Range
        Dim newRng As Range
        Dim c As Range
         
    ReTry:
        shtName = Application.InputBox("Choose a name for the new sheet to list all formulas.", "New Sheet Name") 'the user decides the new sheet name
        If shtName = False Then Exit Sub 'exit if user clicks Cancel
         
        On Error Resume Next
        Set sht = Sheets(shtName) 'check if the sheet exists
        If Not sht Is Nothing Then 'if so, send message and return to input box
            MsgBox "This sheet already exists"
            Err.Clear 'clear error
            Set sht = Nothing 'reset sht for next test
            GoTo ReTry 'loop to input box
        End If
         
        Worksheets.Add.Move after:=Worksheets(Worksheets.Count) 'adds a new sheet at the end
        Application.ScreenUpdating = False
        With ActiveSheet 'the new sheet is automatically the activesheet
            .Range("A1").Value = "Formula" 'puts a heading in cell A1
            .Range("B1").Value = "Sheet Name" 'puts a heading in cell B1
            .Range("C1").Value = "Cell Address" 'puts a heading in cell C1
            .Name = shtName 'names the new sheet from InputBox
        End With
         
        For Each sht In ActiveWorkbook.Worksheets 'loop through the sheets in the workbook
            If sht.Name <> shtName Then 'exclude the sheet just created
                Set myRng = sht.UsedRange 'limit the search to the UsedRange
                On Error Resume Next 'in case there are no formulas
                Set newRng = myRng.SpecialCells(xlCellTypeFormulas) 'use SpecialCells to reduce looping further
                For Each c In newRng 'loop through the SpecialCells only
                    Sheets(shtName).Range("A65536").End(xlUp).Offset(1, 0).Value = Mid(c.Formula, 2, (Len(c.Formula)))
                     'places the formula minus the '=' sign in column A
                    Sheets(shtName).Range("B65536").End(xlUp).Offset(1, 0).Value = sht.Name
                     'places the sheet name containing the formula in column B
                    Sheets(shtName).Range("C65536").End(xlUp).Offset(1, 0).Value = Application.WorksheetFunction.Substitute(c.Address, "$", "")
                     'places the cell address, minus the "$" signs, containing the formula in column C
                Next c
            End If
        Next sht
        Sheets(shtName).Activate 'make the new sheet the activesheet
        ActiveSheet.Columns("A:C").AutoFit 'autofit the data
        Application.ScreenUpdating = True
    End Sub

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,241
    Location
    Hi oam,

    You can give the below a try, it assumes you will put the headers in the result sheet (A1:C1). You may also want to include a line of code to clear the result sheet before it adds new results to it:

    Sub ListAllFormulas()
        Dim sht As Worksheet, rSheet As Worksheet
        Dim myRng As Range, newRng As Range, c As Range
        Dim endRow As Long
         
        Set rSheet = Sheets("Sheet3") ' results sheet
        Set sht = Sheets("Sheet1") ' sheet to search
        Set myRng = sht.UsedRange 'limit the search to the UsedRange
        
        On Error Resume Next 'in case there are no formulas
        Set newRng = myRng.SpecialCells(xlCellTypeFormulas) 'use SpecialCells to reduce looping further
        For Each c In newRng 'loop through the SpecialCells only
            With rSheet
                endRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' sets the next row on the results sheet
                .Range("A" & endRow).Value = Mid(c.Formula, 2, (Len(c.Formula))) 'places the formula minus the '=' sign in column A
                .Range("B" & endRow).Value = sht.Name 'places the sheet name containing the formula in column B
                .Range("C" & endRow).Value = Application.WorksheetFunction.Substitute(c.Address, "$", "") 'places the cell address, minus the "$" signs, containing the formula in column C
            End With
        Next c
        On Error GoTo 0
    
        rSheet.Columns("A:C").AutoFit 'autofit the data
    End Sub
    Hope this helps
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  3. #3
    VBAX Contributor
    Joined
    Oct 2013
    Posts
    181
    Location
    georgiboy,

    The code works great!!!

    Thank you so much for your help!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •