Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help with time audit | Excel Discussion (Misc queries) | |||
Audit Trail | Excel Discussion (Misc queries) | |||
need help have audit and i'm going to get slaughtered unless | Excel Worksheet Functions | |||
Worksheet audit | Excel Programming | |||
Audit Programme | Excel Programming |