I have two worksheets. I need to compare both worksheets then output
report that shows the difference between the sheets. I have that muc
done. I can run a compare and then populate an 'output' worksheet wit
the changed cells.

My issue is that I want the script to recognize the changed cell an
copy the entire row that that discrepency cell is in, and copy tha
whole row to the output worksheet. I'm attempting it in a loop. It ha
to compare all the cells in the rows of both worksheets. Follows is th
script. Sorry if it's sloppy but I'm fairly new with VBA. Any help woul
be much appreciated.

Sub CompareWorksheetRanges(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
Dim chnCell As Long, sameCell As Long
Dim rwRange As Range, clRange As Range

If rng1 Is Nothing Or rng2 Is Nothing Then Exit Sub
If rng1.Areas.Count 1 Or rng2.Areas.Count 1 Then
MsgBox "Can't compare multiple selections!", _
vbExclamation, "Compare Worksheet Ranges"
Exit Sub
End If
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
With rng1
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With rng2
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Comparing cells " & _
Format(c / maxC, "0 %") & "..."
For r = 1 To maxR
On Error Resume Next
cf1 = rng1.Cells(r, c).FormulaLocal
cf2 = rng2.Cells(r, c).FormulaLocal
On Error GoTo 0

If cf1 < cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & " < " & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", _
vbInformation, "Compare Worksheet Ranges"
Sheets("Sheet1").Select
Sheets("Sheet1").Copy Befo=Workbooks("RadarSen_r1.xls").Sheets(1)
Workbooks(2).Close False

End Su

--
malefeou
-----------------------------------------------------------------------
malefeous's Profile: http://www.excelforum.com/member.php...fo&userid=2606
View this thread: http://www.excelforum.com/showthread.php?threadid=39420