Thanks to Joel
I am now using this:
'===================
Sub CheckRev_v2()
'====================
'Originating author: Joel from "microsoft.public.excel.programming" 10.09.07
'====================
Application.ScreenUpdating = False
With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh1Range = .Range("A1:A" & Sh1LastRow)
End With
With Sheets("Sheet2")
Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh2Range = .Range("A1:A" & Sh2LastRow)
End With
'compare sheet 1 with sheet 2
For Each Sh1cell In Sh1Range
Set c = Sh2Range.Find( _
what:=Sh1cell, LookIn:=xlValues)
If c Is Nothing Then
Sh1cell.Offset(0, 2).Value = "No Match Found!"
Sh1cell.Offset(0, 2).Font.Color = -16776961
Sh1cell.Offset(0, 2).Font.Bold = True
'Sh1cell.Offset(0, 3).Value = Sh1cell.Offset(0, 1).Value 'enters Rev
level
Else
If Sh1cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh1cell.Offset(0, 2).Font.Italic = True
Sh1cell.Offset(0, 2).ColumnWidth = 25
Sh1cell.Offset(0, 2).Value = "Revision Level Change!"
End If
End If
Next Sh1cell
'compare sheet 2 with sheet 1
For Each Sh2cell In Sh2Range
Set c = Sh1Range.Find( _
what:=Sh2cell, LookIn:=xlValues)
If c Is Nothing Then
Sh2cell.Offset(0, 2).Value = "No Match Found!"
Sh2cell.Offset(0, 2).Font.Color = -16776961
Sh2cell.Offset(0, 2).Font.Bold = True
'Sh2cell.Offset(0, 3).Value = Sh2cell.Offset(0, 1).Value 'enters Rev
level
Else
If Sh2cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh2cell.Offset(0, 2).Font.Italic = True
Sh2cell.Offset(0, 2).ColumnWidth = 25
Sh2cell.Offset(0, 2).Value = "Revision Level Change!"
End If
End If
Next Sh2cell
Application.ScreenUpdating = True
End Sub
'=====================
--
Regards
Rick
XP Pro
Office 2007
"Joel" wrote:
> The code below performs a two way comparison. First it compares sheet 1 with
> 2, and the sheet 2 with 1.
>
> It highlight in yellow rows with different version letters on each sheet.
> It highlights in Red when one row is not found in the other sheet.
>
> Code is fully automatic. It check for the last row on each sheet and stop
> running when it reaches these rows.
>
> Sub checkrev()
>
> With Sheets("Sheet1")
> Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
> Set Sh1Range = .Range("A1:A" & Sh1LastRow)
> End With
> With Sheets("Sheet2")
> Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
> Set Sh2Range = .Range("A1:A" & Sh2LastRow)
> End With
>
> 'compare sheet 1 with sheet 2
> For Each Sh1cell In Sh1Range
> Set c = Sh2Range.Find( _
> what:=Sh1cell, LookIn:=xlValues)
> If c Is Nothing Then
> Sh1cell.Interior.ColorIndex = 3
> Sh1cell.Offset(0, 1).Interior.ColorIndex = 3
> Else
> If Sh1cell.Offset(0, 1) <> c.Offset(0, 1) Then
> Sh1cell.Interior.ColorIndex = 6
> Sh1cell.Offset(0, 1).Interior.ColorIndex = 6
> End If
> End If
> Next Sh1cell
> 'compare sheet 2 with sheet 1
> For Each Sh2cell In Sh2Range
> Set c = Sh1Range.Find( _
> what:=Sh2cell, LookIn:=xlValues)
> If c Is Nothing Then
> Sh2cell.Interior.ColorIndex = 3
> Sh2cell.Offset(0, 1).Interior.ColorIndex = 3
> Else
> If Sh2cell.Offset(0, 1) <> c.Offset(0, 1) Then
> Sh2cell.Interior.ColorIndex = 6
> Sh2cell.Offset(0, 1).Interior.ColorIndex = 6
> End If
> End If
> Next Sh2cell
>
> End Sub
>
>
> "Rick S." wrote:
>
> > I am not sure if this is possible.
> > I have a single workbook that has two columns in two worksheets. The data
> > on sheet1 Column1 is a list of specs we use and Column2 is the Revision
> > level. Sheet2 has the same layout/format except the list may be longer or
> > shorter than Sheet1.
> >
> > Can I compare data on Sheet1 (Column1 then Column2) to Sheet2 (Column1 then
> > Column2)?
> > How can I flag a Zero Match condition and or Revision Level difference?
> >
> > Sheet1
> > Column1 Column2
> > GPS 1000-1 A
> > GPS 1000-2 B
> > GPS 1000-3 A
> > GPS 1000-4 A
> >
> > Sheet2
> > Column1 Column2
> > GPS 1000-1 A
> > GPS 1000-3 B
> > GPS 1000-4 A
> > GPS 1000-5 A
> >
> > --
> > Regards
> >
> > Rick
> > XP Pro
> > Office 2007
> >
|
Similar Threads
