identifying and moving matching values
The code below is intended to pick out the matching pairs and color
them blue. However it seems to act at random.
Anyone have any suggestions. As to how to find cells that are identical
and in adjacent rows I would be very grateful.
Sub matching()
Dim lastrow As Long
lastrow = Cells(65536, 1).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, 1).Value = Cells(i - 1, 1).Value And Cells(i, 4).Value =
Cells(i - 1, 4) Then
Cells(i, 1).Resize(2, 5).Font.ColorIndex = 11
Cells(i - 1, 1).Resize(2, 5).Font.ColorIndex = 11
End If
Next i
End Sub
|