Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 14
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Help with time audit Mike Busch[_2_] Excel Discussion (Misc queries) 0 December 18th 07 03:21 PM
Audit Trail Pendelfin Excel Discussion (Misc queries) 1 January 23rd 06 03:04 PM
need help have audit and i'm going to get slaughtered unless dont think auditors deserveyourmoney guy Excel Worksheet Functions 4 May 24th 05 12:43 AM
Worksheet audit Dr.Schwartz Excel Programming 2 January 31st 05 11:35 AM
Audit Programme Steved[_3_] Excel Programming 6 September 7th 04 01:58 AM


All times are GMT +1. The time now is 07:42 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"