View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] aztecbrainsurgeon@yahoo.com is offline
external usenet poster
 
Posts: 17
Default Find duplicate range or cell ref (as precedents) in a cell's formula - an example

No question here, just a procedure example for the achive.

Find duplicate range or cell references (as precedents) in a cell's
formula - an example

Sub FormulaDuplicateRefCheck()
'Checks each cell's formula in the selection for any duplicate/
multiple reference
'to the same range in the formula

Dim c, cell, evalCell, OriginalSelection As Range
Dim acFormula, cAddress, FoundRange As String
Dim CountCharacter, I As Integer
' On Error Resume Next
Set OriginalSelection = Selection
'Loop through each cell in the selection

For Each evalCell In OriginalSelection
On Error Resume Next

'Turn the evaluated cell's formula into a string
acFormula = evalCell.Formula
'Turn the evaluated cell's precedent(s) address references
into into a string
acPrecAddress =
evalCell.Precedents.Address(RowAbsolute:=False, ColumnAbsolute:=False)
'Select the evaluated cell's precedent(s) address references

evalCell.Precedents.Select


' Loop through each cell in the evaluated cell's precendents
cells
For Each c In Selection
'Turn each precedent cell address into a string
cAddress = c.Address(RowAbsolute:=False,
ColumnAbsolute:=False)

'compare the precedent cell address to the evaluated
cell's formula as a string
'to indentify the number of occurrences of the precedent
cell's reference
For I = 1 To Len(acFormula)
If Mid(acFormula, I, Len(cAddress)) = cAddress Then
CountCharacter = CountCharacter + 1
End If
Next
'if there is more than one occurence then add the
precedent cell address to
'a string list
If CountCharacter = 2 Then
FoundRange = FoundRange & vbLf & cAddress
End If
CountCharacter = 0

Next c
'Test for existence of items in the multiple reference string
list
If Len(FoundRange) = 1 Then

MsgBox "Cell " & evalCell.Address(RowAbsolute:=False,
ColumnAbsolute:=False) _
& " has duplicate range reference(s): " &
FoundRange
End If
FoundRange = ""
Next evalCell
OriginalSelection.Select
End Sub

Note: the above code doesn't identify any duplicate Named Ranges. It
only works with standard cell range references.

Also:

Sub FormulaINCONSISTENCYCheck()
'Check a range of cells to see if their formulas are consistent
'when compared amongst themselves

'Consistent formulas in the region must reside to the left and
'right or above and below the cell containing the inconsistent
'formula for the InconsistentFormula property to work properly.

Dim c As Range

For Each c In Selection
' Perform check to see cell has an inconsistent formula
If c.Errors.Item(xlInconsistentFormula).Value = True Then
MsgBox "cell " & c.Address & " has an inconsistent
formula"
End If
Next c
End Sub



seach criteria:
precedent duplicate check
formula reference duplication
duplicate cell references check
duplicate precedents exist
range reference duplication
formula precedents audit
range or cell reference duplication error
formula inconsistent test