Compare and Highlight Differences

[RyGuy]

I am trying to come up with a way of comparing two ranges, which will change
over time, and put together bits of code to create the macro below:


Sub Compare2Shts()

Dim rRange As Range
Dim ws As Worksheet

Set rRange = Nothing
On Error Resume Next
Set rRange = Application.InputBox(Prompt:= _
"Please select a range for input.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
If rRange Is Nothing Then
Exit Sub
End If


InValidEntry:
If Err = 13 Then
MsgBox "Not a valid input. " & "Please retry."
End If

rRange.Select

For Each Cell In Worksheets("Secondary").rRanage
If Cell.Value <> Worksheets("Primary").rRanage Then
Cell.Interior.ColorIndex = 3
End If
Next
End Sub


I was hoping to be able to hold down the Ctrl key and click on two different
sheets and then just select a range one one sheet (and I assume the range on
the second sheet would be identical, in terms of the space covered, for the
comparison of each cell's values).

It fails on the line: rRange.Select

Can someone point out my flaw?

Thanks,
Ryan---

 

[OssieMac]

Hi RyGuy,

I have edited you code to assign a second range on another sheet to a range
identical to the first sheet and then handled the comparison. Under limited
testing it appears to work satisfactorily.

Sub Compare2Shts()

Dim rRangePrimary As Range
Dim rRangeSecondary As Range
Dim wsPrimary As Worksheet
Dim wsSecondary As Worksheet
Dim strPrompt As String

Set wsPrimary = Sheets("Primary")
Set wsSecondary = Sheets("Secondary")

wsPrimary.Select

Set rRangePrimary = Nothing
strPrompt = "Please select a range for input."

Do
On Error Resume Next
Set rRangePrimary = Application.InputBox _
(Prompt:=strPrompt, _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0

If rRangePrimary Is Nothing Then
MsgBox "User cancelled. " & "Processing terminated"
Exit Sub
End If
Loop While rRangePrimary Is Nothing

Set rRangeSecondary = wsSecondary.Range(rRangePrimary.Address)

With rRangeSecondary
For i = 1 To .Rows.Count
If .Cells(i).Value <> rRangePrimary.Cells(i).Value Then
.Cells(i).Interior.ColorIndex = 3
End If
Next i
End With

End Sub

Regards,

OssieMac

 

[OssieMac]

Hi again RyGuy,

My apologies. I forgot to finish the MsgBox to give then user the option of
cancelling or retrying so here it is again.

Sub Compare2Shts()

Dim rRangePrimary As Range
Dim rRangeSecondary As Range
Dim wsPrimary As Worksheet
Dim wsSecondary As Worksheet
Dim strPrompt As String
Dim Response As Variant

Set wsPrimary = Sheets("Primary")
Set wsSecondary = Sheets("Secondary")

wsPrimary.Select

Set rRangePrimary = Nothing
strPrompt = "Please select a range for input."

Do
On Error Resume Next
Set rRangePrimary = Application.InputBox _
(Prompt:=strPrompt, _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0

If rRangePrimary Is Nothing Then
Response = MsgBox("You cancelled. " _
& "Do you want to re-try?", vbYesNo)
If Response = vbNo Then
Exit Sub
End If
End If
Loop While rRangePrimary Is Nothing

Set rRangeSecondary = wsSecondary.Range(rRangePrimary.Address)

With rRangeSecondary
For i = 1 To .Rows.Count
If .Cells(i).Value <> rRangePrimary.Cells(i).Value Then
.Cells(i).Interior.ColorIndex = 3
End If
Next i
End With


End Sub

Regards,

OssieMac

 

[Mike Fogleman]

Ossie, one little change to cover a multiple column range:

For i = 1 To .Rows.Count * .Columns.Count

Mike F

 

[OssieMac]

Hi yet again RyGuy,

Just as well we have observant people like Mike to correct mistakes. Use
Mike's change otherwise my code would only work for one column.

Thanks Mike for pointing out the error.

Regards,

OssieMac

 

[ryguy7272]

Thanks! Both of you, thanks a ton!! I look forward to the day when I can
not only do this stuff 100% by myself, but also, I look forwards to helping
others, as I have received quite extensive help here over the past year or so.

Thanks again!
Ryan--