ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   change audit (https://www.excelbanter.com/excel-programming/331171-re-change-audit.html)

Gary Brown

change audit
 
This function should do it...
Example of syntax would be...
=IdenticalCells(B5,B6)

'/=================================================/
Public Function IdenticalCells(rng1 As Range, rng2 As Range) As Long
'0 = different / 1 = same

Application.Volatile

IdenticalCells = 1

On Error GoTo exit_Function

'values and/or text do not equal
If rng1.value < rng2.value Then IdenticalCells = 0

'one has formula and other does not
If (rng1.HasFormula = True And rng2.HasFormula = False) _
Or (rng1.HasFormula = False And rng2.HasFormula = True) Then _
IdenticalCells = 0

'one has comment and other does not
If (HasComment(rng1) = True And HasComment(rng2) = False) _
Or (HasComment(rng1) = False And HasComment(rng2) = True) Then _
IdenticalCells = 0

'different background colors
If rng1.Interior.Color < rng2.Interior.Color Then IdenticalCells = 0

'different text alignments and other text characteristics
If rng1.HorizontalAlignment < rng2.HorizontalAlignment Then
IdenticalCells = 0
If rng1.VerticalAlignment < rng2.VerticalAlignment Then IdenticalCells = 0
If rng1.WrapText < rng2.WrapText Then IdenticalCells = 0
If rng1.Orientation < rng2.Orientation Then IdenticalCells = 0
If rng1.AddIndent < rng2.AddIndent Then IdenticalCells = 0
If rng1.ShrinkToFit < rng2.ShrinkToFit Then IdenticalCells = 0
If rng1.MergeCells < rng2.MergeCells Then IdenticalCells = 0

'different fonts
If rng1.Font.Background < rng2.Font.Background Then IdenticalCells = 0
If rng1.Font.Bold < rng2.Font.Bold Then IdenticalCells = 0
If rng1.Font.Color < rng2.Font.Color Then IdenticalCells = 0
If rng1.Font.FontStyle < rng2.Font.FontStyle Then IdenticalCells = 0
If rng1.Font.Italic < rng2.Font.Italic Then IdenticalCells = 0
If rng1.Font.name < rng2.Font.name Then IdenticalCells = 0
If rng1.Font.OutlineFont < rng2.Font.OutlineFont Then IdenticalCells = 0
If rng1.Font.Shadow < rng2.Font.Shadow Then IdenticalCells = 0
If rng1.Font.Size < rng2.Font.Size Then IdenticalCells = 0
If rng1.Font.Strikethrough < rng2.Font.Strikethrough Then IdenticalCells
= 0
If rng1.Font.Subscript < rng2.Font.Subscript Then IdenticalCells = 0
If rng1.Font.Superscript < rng2.Font.Superscript Then IdenticalCells = 0
If rng1.Font.Underline < rng2.Font.Underline Then IdenticalCells = 0

'different borders
If rng1.Borders(xlDiagonalDown).LineStyle < _
rng2.Borders(xlDiagonalDown).LineStyle _
Then IdenticalCells = 0
If rng1.Borders(xlDiagonalDown).Weight < _
rng2.Borders(xlDiagonalDown).Weight _
Then IdenticalCells = 0
If rng1.Borders(xlDiagonalDown).ColorIndex < _
rng2.Borders(xlDiagonalDown).ColorIndex _
Then IdenticalCells = 0
If rng1.Borders(xlDiagonalUp).LineStyle < _
rng2.Borders(xlDiagonalUp).LineStyle _
Then IdenticalCells = 0
If rng1.Borders(xlDiagonalUp).Weight < _
rng2.Borders(xlDiagonalUp).Weight _
Then IdenticalCells = 0
If rng1.Borders(xlDiagonalUp).ColorIndex < _
rng2.Borders(xlDiagonalUp).ColorIndex _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeLeft).LineStyle < _
rng2.Borders(xlEdgeLeft).LineStyle _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeLeft).Weight < _
rng2.Borders(xlEdgeLeft).Weight _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeLeft).ColorIndex < _
rng2.Borders(xlEdgeLeft).ColorIndex _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeTop).LineStyle < _
rng2.Borders(xlEdgeTop).LineStyle _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeTop).Weight < _
rng2.Borders(xlEdgeTop).Weight _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeTop).ColorIndex < _
rng2.Borders(xlEdgeTop).ColorIndex _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeBottom).LineStyle < _
rng2.Borders(xlEdgeBottom).LineStyle _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeBottom).Weight < _
rng2.Borders(xlEdgeBottom).Weight _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeBottom).ColorIndex < _
rng2.Borders(xlEdgeBottom).ColorIndex _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeRight).LineStyle < _
rng2.Borders(xlEdgeRight).LineStyle _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeRight).Weight < _
rng2.Borders(xlEdgeRight).Weight _
Then IdenticalCells = 0
If rng1.Borders(xlEdgeRight).ColorIndex < _
rng2.Borders(xlEdgeRight).ColorIndex _
Then IdenticalCells = 0

exit_Function:
Exit Function

End Function
'/=================================================/
Private Function HasComment(rng As Range) As Boolean
Dim var As Variant
On Error GoTo err_Function
HasComment = True

var = rng.Comment.Parent.Address

exit_Function:
Exit Function

err_Function:
HasComment = False

End Function
'/=================================================/

HTH,
--
Gary Brown

Please rate this posting if it is helpful to you.


"Gary's Student" wrote:

I am doing change audits and need a function to determine if two cells are
identical
Example: =SomeFunction(A1,B2) returns 1 if A1 and B2 are identical,
otherwise 0.

A1 and B2 are not identical if:

1. they contain different values
2. one contains a value, the other a formula
3. one contains a comment, the other not
4. the background colors differ
5. text strings contained in the cells are different
6. text alignments are different
7. fonts are different
8. borders are different

Thanks in advance for your help

--
Gary's Student



All times are GMT +1. The time now is 12:31 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com