none
VBA code for Listing all cells in the workbook which have no dependents cells RRS feed

  • Question

  • Hello Community,

    I am looking for a code which can derive me a list of cells which doesnt add further value to the other cells. (means are dead ene)

    This is very crucial for me to identify to alter a big financail model.

    I know I can find it out manually. But I wish there is an automated way of getting such list so I dont have to do it manually and thereby saving time and efficiency.

    Thanks in Advance.

    Dhaval Paun

    Monday, April 4, 2016 12:48 PM

Answers

  • See below image. I have highlighted in red the cells which are deriving no further value (dead End)

    Below are 2 macros, 1st to select all "dead ends", 2nd to get the dead ends from the active cell only.

    Andreas.

    Option Explicit
    
    Sub All_Dependents()
      Dim R As Range, All As Range, This As Range
      
      On Error GoTo NoDependents
      For Each R In SpecialCells(ActiveSheet.UsedRange, xlCellTypeConstants Or xlCellTypeFormulas)
        Set This = R.DirectDependents
    NextCell:
      Next
      On Error Resume Next
      All.Select
      MsgBox All.Address(0, 0), , "Dead ends"
      Exit Sub
      
    NoDependents:
      If All Is Nothing Then
        Set All = R
      Else
        Set All = Union(All, R)
      End If
      Resume NextCell
    End Sub
    
    Sub ActiveCell_Dependents()
      Dim C As New Collection
      Dim i As Long
      Dim Here As Range, R As Range, All As Range
      
      ActiveSheet.ClearArrows
      C.Add ActiveCell
      On Error GoTo NoDependents
      Do
        i = i + 1
        Set Here = C.Item(i)
        Here.ShowDependents
        For Each R In Here.DirectDependents
          DoEvents
          C.Add R
        Next
    NextCell:
      Loop Until i = C.Count
      On Error GoTo 0
      If All.Address = ActiveCell.Address Then
        MsgBox "No Dependents"
      Else
        MsgBox All.Address(0, 0), , "Dependents of " & ActiveCell.Address(0, 0)
      End If
      Exit Sub
      
    NoDependents:
      If All Is Nothing Then
        Set All = Here
      Else
        Set All = Union(All, Here)
      End If
      Resume NextCell
    End Sub
    
    Private Function SpecialCells(ByVal R As Range, ByVal Typ As XlCellType, _
        Optional ByVal Value As XlSpecialCellsValue = &H17) As Range
      'Avoid the SpecialCells-BUG to return all cells from the current region
      On Error Resume Next
      Select Case Typ
        Case xlCellTypeConstants, xlCellTypeFormulas
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ, Value))
        Case xlCellTypeConstants Or xlCellTypeFormulas
          'Special feature: Return all used cells
          Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeConstants, Value))
          If SpecialCells Is Nothing Then
            Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value))
          Else
            Set SpecialCells = Union(SpecialCells, Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value)))
          End If
        Case Else
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ))
      End Select
    End Function
    
    


    Monday, April 4, 2016 3:02 PM
  • 1. To list the cells in a New worksheet rather than showing as Dialogue box. (each entry in individual cell)

    2. Is it possible to do it for all worksheets with one run of macro......I have many Worksheets. (at 1.

    Option Explicit
    
    Sub All_Dependents_NewSheet()
      Dim R As Range, All As Range, This As Range
      Dim Ws As Worksheet
      Dim Result As New Collection
      Dim Item, Data, i As Long
      
      On Error GoTo NoDependents
      For Each Ws In Worksheets
        Set All = Nothing
        For Each R In SpecialCells(Ws.UsedRange, xlCellTypeConstants Or xlCellTypeFormulas)
          Set This = R.DirectDependents
    NextCell:
        Next
        Result.Add Ws.Name
        If All Is Nothing Then
          Result.Add "no cells"
        Else
          Result.Add All.Address(0, 0)
        End If
      Next
      ReDim Data(1 To Result.Count, 1 To 1)
      For Each Item In Result
        i = i + 1
        Data(i, 1) = Item
      Next
      Worksheets.Add
      Range("A1").Resize(UBound(Data), 1).Value = Data
      Exit Sub
      
    NoDependents:
      If All Is Nothing Then
        Set All = R
      Else
        Set All = Union(All, R)
      End If
      Resume NextCell
    End Sub
    
    Private Function SpecialCells(ByVal R As Range, ByVal Typ As XlCellType, _
        Optional ByVal Value As XlSpecialCellsValue = &H17) As Range
      'Avoid the SpecialCells-BUG to return all cells from the current region
      On Error Resume Next
      Select Case Typ
        Case xlCellTypeConstants, xlCellTypeFormulas
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ, Value))
        Case xlCellTypeConstants Or xlCellTypeFormulas
          'Special feature: Return all used cells
          Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeConstants, Value))
          If SpecialCells Is Nothing Then
            Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value))
          Else
            Set SpecialCells = Union(SpecialCells, Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value)))
          End If
        Case Else
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ))
      End Select
    End Function
    


    Tuesday, April 5, 2016 7:15 AM

All replies

  • In order to avoid misunderstanding, can you provide an example of

    1. a cell that does "add further value to the other cells"
    and an example of
    2. a cell that does NOT "add further value to the other cells"


    Best regards, George

    Monday, April 4, 2016 2:15 PM
  • See below image. I have highlighted in red the cells which are deriving no further value (dead End)

    A highlight of all such cells will be helpful if "Listing them separately" is not possible

    http://www.screencast.com/t/xsK1d4BfQ6dq

    Monday, April 4, 2016 2:33 PM
  • I see the picture but what's the difference between what I have squared in blue?


    Best regards, George

    Monday, April 4, 2016 2:58 PM
  • See below image. I have highlighted in red the cells which are deriving no further value (dead End)

    Below are 2 macros, 1st to select all "dead ends", 2nd to get the dead ends from the active cell only.

    Andreas.

    Option Explicit
    
    Sub All_Dependents()
      Dim R As Range, All As Range, This As Range
      
      On Error GoTo NoDependents
      For Each R In SpecialCells(ActiveSheet.UsedRange, xlCellTypeConstants Or xlCellTypeFormulas)
        Set This = R.DirectDependents
    NextCell:
      Next
      On Error Resume Next
      All.Select
      MsgBox All.Address(0, 0), , "Dead ends"
      Exit Sub
      
    NoDependents:
      If All Is Nothing Then
        Set All = R
      Else
        Set All = Union(All, R)
      End If
      Resume NextCell
    End Sub
    
    Sub ActiveCell_Dependents()
      Dim C As New Collection
      Dim i As Long
      Dim Here As Range, R As Range, All As Range
      
      ActiveSheet.ClearArrows
      C.Add ActiveCell
      On Error GoTo NoDependents
      Do
        i = i + 1
        Set Here = C.Item(i)
        Here.ShowDependents
        For Each R In Here.DirectDependents
          DoEvents
          C.Add R
        Next
    NextCell:
      Loop Until i = C.Count
      On Error GoTo 0
      If All.Address = ActiveCell.Address Then
        MsgBox "No Dependents"
      Else
        MsgBox All.Address(0, 0), , "Dependents of " & ActiveCell.Address(0, 0)
      End If
      Exit Sub
      
    NoDependents:
      If All Is Nothing Then
        Set All = Here
      Else
        Set All = Union(All, Here)
      End If
      Resume NextCell
    End Sub
    
    Private Function SpecialCells(ByVal R As Range, ByVal Typ As XlCellType, _
        Optional ByVal Value As XlSpecialCellsValue = &H17) As Range
      'Avoid the SpecialCells-BUG to return all cells from the current region
      On Error Resume Next
      Select Case Typ
        Case xlCellTypeConstants, xlCellTypeFormulas
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ, Value))
        Case xlCellTypeConstants Or xlCellTypeFormulas
          'Special feature: Return all used cells
          Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeConstants, Value))
          If SpecialCells Is Nothing Then
            Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value))
          Else
            Set SpecialCells = Union(SpecialCells, Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value)))
          End If
        Case Else
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ))
      End Select
    End Function
    
    


    Monday, April 4, 2016 3:02 PM
  • A1 is used in a formula in A3

    Whereas A5 is not used any other formula.

    Also A3 itself is not used any other formula.

    I hope I have made clear what I require.

    Monday, April 4, 2016 3:14 PM
  • Ok, yes, you did. But you've got an excellent answer from Andreas. I hope that is what you need.

    Best regards, George

    Monday, April 4, 2016 3:16 PM
  • Hello Andreas,

    Thats really Great......Is there any way to achieve below:

    1. To list the cells in a New worksheet rather than showing as Dialogue box. (each entry in individual cell)

    2. Is it possible to do it for all worksheets with one run of macro......I have many Worksheets. (at 1. above, it gives worksheet name corresponding column)

    Thanks a lot....You saved my day

    Monday, April 4, 2016 3:24 PM
  • Hi Dhaval,

    Did the code from Andreas work for you? I found you unmark, is there any issue in this code?

    >> Is there any way to achieve below

    For this new requirement, I would suggest you post new threads for them. You could loop through all worksheets to run macro.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Tuesday, April 5, 2016 3:09 AM
  • 1. To list the cells in a New worksheet rather than showing as Dialogue box. (each entry in individual cell)

    2. Is it possible to do it for all worksheets with one run of macro......I have many Worksheets. (at 1.

    Option Explicit
    
    Sub All_Dependents_NewSheet()
      Dim R As Range, All As Range, This As Range
      Dim Ws As Worksheet
      Dim Result As New Collection
      Dim Item, Data, i As Long
      
      On Error GoTo NoDependents
      For Each Ws In Worksheets
        Set All = Nothing
        For Each R In SpecialCells(Ws.UsedRange, xlCellTypeConstants Or xlCellTypeFormulas)
          Set This = R.DirectDependents
    NextCell:
        Next
        Result.Add Ws.Name
        If All Is Nothing Then
          Result.Add "no cells"
        Else
          Result.Add All.Address(0, 0)
        End If
      Next
      ReDim Data(1 To Result.Count, 1 To 1)
      For Each Item In Result
        i = i + 1
        Data(i, 1) = Item
      Next
      Worksheets.Add
      Range("A1").Resize(UBound(Data), 1).Value = Data
      Exit Sub
      
    NoDependents:
      If All Is Nothing Then
        Set All = R
      Else
        Set All = Union(All, R)
      End If
      Resume NextCell
    End Sub
    
    Private Function SpecialCells(ByVal R As Range, ByVal Typ As XlCellType, _
        Optional ByVal Value As XlSpecialCellsValue = &H17) As Range
      'Avoid the SpecialCells-BUG to return all cells from the current region
      On Error Resume Next
      Select Case Typ
        Case xlCellTypeConstants, xlCellTypeFormulas
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ, Value))
        Case xlCellTypeConstants Or xlCellTypeFormulas
          'Special feature: Return all used cells
          Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeConstants, Value))
          If SpecialCells Is Nothing Then
            Set SpecialCells = Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value))
          Else
            Set SpecialCells = Union(SpecialCells, Intersect(R, R.SpecialCells(xlCellTypeFormulas, Value)))
          End If
        Case Else
          Set SpecialCells = Intersect(R, R.SpecialCells(Typ))
      End Select
    End Function
    


    Tuesday, April 5, 2016 7:15 AM
  • Andrea, You are Genius.

    I have tested above code. The only Problem now is 

    if a cell has dependencies in other worksheet, it is getting listed in the output file.

    Which I think must be not listed. Most of my cells in a particular worksheet has reference to other worksheet rather than within worksheet.

    Let me know if this is possible. It would add a great value.


    Tuesday, April 5, 2016 10:54 AM
  • Hi DhavalPaun,

    >> if a cell has dependencies in other worksheet, it is getting listed in the output file.
    For this requirement, I suggest you check the formula of cell, if it contains other sheets, do not list.

    Sub test()
    Debug.Print ActiveSheet.Name
    Debug.Print ActiveCell.Formula
    End Sub

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Wednesday, April 6, 2016 7:30 AM
  • Hi Edward,

    I didnt get your point.

    Can you explain further like what the macro you have give will do and where I have to insert in the existing macro.

    Thanks

    Dhaval

    Wednesday, April 6, 2016 8:04 AM
  • I didnt get your point.

    The point is that Range.DirectDependents did not support references to other sheets.
    https://msdn.microsoft.com/de-de/library/microsoft.office.interop.excel.range.directdependents%28v=office.11%29.aspx

    To clarify, if Sheet1!C3 contains a formula =Sheet2!A1 in means in your case the dead end is Sheet2!A1 and not Sheet1!C3 as the code above shows.

    It is possible to solve that, because we can parse the formula and get the dependents to other sheets (and files), except INDIRECT formulas.

    But that requires a lot of code... and I need to have a look into your file. If you are interested, look into my profile for my mail address and send me your file, I'll make you an offer.

    Andreas.

    Wednesday, April 6, 2016 1:42 PM
  • Andreas,

    You have done a great job and it's unfortunate that the OP is not grateful for your work but wants more on a free basis.


    Best regards, George

    Wednesday, April 6, 2016 2:07 PM