geomano
03-07-2017, 02:26 PM
Hi,
I am trying to create a Macro, which will run through 4 columns (2 in each tab) and highlight the values, which are duplicated ONLY if there is a match between 2 rows in each tab.
I am using the code below:
Sub Dups() Dim rCriteria As Range
Dim rData As Range
Dim c As Range, R As Range
Dim sFirstAddress As String
Dim ColorCounter As Long
Dim StartTime As Single, EndTime As Single
Set rCriteria = Sheets(1).Range("a2:b1000")
Set rData = Sheets(2).Range("a2:b1000")
Application.ScreenUpdating = False
With rData
.Interior.ColorIndex = xlNone
For Each R In rCriteria
If Not R = "" Then
Set c = .Find(what:=R.Value, LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlNext)
If Not c Is Nothing Then
sFirstAddress = c.Address
Do
Set c = .FindNext(c)
c.Interior.Color = vbYellow
ColorCounter = ColorCounter + 1
Loop Until c.Address = sFirstAddress
End If
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
It seems that there is an issue with range, as macro is highlighting every row, where there is a match between only 1 row.
I am attaching the workbook.
Many thanks for help with this.
I am trying to create a Macro, which will run through 4 columns (2 in each tab) and highlight the values, which are duplicated ONLY if there is a match between 2 rows in each tab.
I am using the code below:
Sub Dups() Dim rCriteria As Range
Dim rData As Range
Dim c As Range, R As Range
Dim sFirstAddress As String
Dim ColorCounter As Long
Dim StartTime As Single, EndTime As Single
Set rCriteria = Sheets(1).Range("a2:b1000")
Set rData = Sheets(2).Range("a2:b1000")
Application.ScreenUpdating = False
With rData
.Interior.ColorIndex = xlNone
For Each R In rCriteria
If Not R = "" Then
Set c = .Find(what:=R.Value, LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlNext)
If Not c Is Nothing Then
sFirstAddress = c.Address
Do
Set c = .FindNext(c)
c.Interior.Color = vbYellow
ColorCounter = ColorCounter + 1
Loop Until c.Address = sFirstAddress
End If
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
It seems that there is an issue with range, as macro is highlighting every row, where there is a match between only 1 row.
I am attaching the workbook.
Many thanks for help with this.