finding duplicates

[Steved]

Hello from Steved

I've 3 worksheets "20-Jun-08", "13-Jun-08", "06-Jun-08"

My question is please is that I've an employee numbers on all 3 worksheets

My Objective is if an employee number is on Sheet 20-Jun-2008 I would like
it to be highlighted in red if found on any of the other 2 worksheets. It may
appear on the other sheets several times but all is required it finds the
first instance ignore the rest.

So in Short find 1 only if found on other 2 worksheets

Thankyou.

 

[JLGWhiz]

I threw this together without testing, so you might have to tweak it.
If your employee numbers are not in column A, you will need to make
those changes in the code. It also assumes one header row.


Sub TurnRed()
Dim lr As Long, lr2 As Long, lr3 As Long
lr = Sheets("20-Jun-08").Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Sheets("13-Jun-08").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Sheets("06-Jun-08").Cells(Rows.Count, 1).End(xlUp).Row
Set myRng = Sheets("20-Jun-08").Range("A2:A" & lr)
For Each c In myRng
Set fVal = Sheets("13-Jun-08").Range("A2:A" & lr2) _
.Find(c, LookIn:=xlValues)
If Not fVal Is Nothing Then
Sheets("20-Jun-08").Range(c.Address).Interior _
.ColorIndex = 3
Else
Set fVal = Sheets("06-Jun-08").Range("A2:A" & lr3) _
.Find(c, LookIn:=xlValues)
If Not fVal Is Nothing Then
Sheets("20-Jun-08").Range(c.Address).Interior _
.ColorIndex = 3
End If
End If
Next
End Sub

 

[RyanH]

This should work for you. Assuming the Employees Names are all in Col. A on
each sheet.

Sub FindEmployee()

Dim LastRow20 As Long
Dim LastRow13 As Long
Dim LastRow6 As Long
Dim EmployeeRange As Range
Dim Range13 As Range
Dim Range6 As Range
Dim Employee As Range
Dim A As Variant
Dim B As Variant

Application.ScreenUpdating = False

LastRow20 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set EmployeeRange = Sheets("Sheet1").Range(Cells(1, "A"),
Cells(LastRow20, "A"))

LastRow13 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set Range13 = Sheets("Sheet2").Range("A1:A" & LastRow13)

LastRow6 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
Set Range6 = Sheets("Sheet3").Range("A1:A" & LastRow6)


For Each Employee In EmployeeRange

Set A = Range13.Find(What:=Employee.Value, LookIn:=xlValues)
Set B = Range6.Find(What:=Employee.Value, LookIn:=xlValues)

If Not A Is Nothing Or Not B Is Nothing Then
Employee.Interior.ColorIndex = 3
End If

Next Employee

Application.ScreenUpdating = True

End Sub

Hope this helps! If it does please give credit.

 

[Steved]

Hello from Steved

Thankyou.

I threw this together without testing, so you might have to tweak it.
If your employee numbers are not in column A, you will need to make
those changes in the code. It also assumes one header row.


Sub TurnRed()
Dim lr As Long, lr2 As Long, lr3 As Long
lr = Sheets("20-Jun-08").Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Sheets("13-Jun-08").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Sheets("06-Jun-08").Cells(Rows.Count, 1).End(xlUp).Row
Set myRng = Sheets("20-Jun-08").Range("A2:A" & lr)
For Each c In myRng
Set fVal = Sheets("13-Jun-08").Range("A2:A" & lr2) _
.Find(c, LookIn:=xlValues)
If Not fVal Is Nothing Then
Sheets("20-Jun-08").Range(c.Address).Interior _
.ColorIndex = 3
Else
Set fVal = Sheets("06-Jun-08").Range("A2:A" & lr3) _
.Find(c, LookIn:=xlValues)
If Not fVal Is Nothing Then
Sheets("20-Jun-08").Range(c.Address).Interior _
.ColorIndex = 3
End If
End If
Next
End Sub

 

[Steved]

Hello RyanH

I thankyou

Steved

This should work for you. Assuming the Employees Names are all in Col. A on
each sheet.

Sub FindEmployee()

Dim LastRow20 As Long
Dim LastRow13 As Long
Dim LastRow6 As Long
Dim EmployeeRange As Range
Dim Range13 As Range
Dim Range6 As Range
Dim Employee As Range
Dim A As Variant
Dim B As Variant

Application.ScreenUpdating = False

LastRow20 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set EmployeeRange = Sheets("Sheet1").Range(Cells(1, "A"),
Cells(LastRow20, "A"))

LastRow13 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set Range13 = Sheets("Sheet2").Range("A1:A" & LastRow13)

LastRow6 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
Set Range6 = Sheets("Sheet3").Range("A1:A" & LastRow6)


For Each Employee In EmployeeRange

Set A = Range13.Find(What:=Employee.Value, LookIn:=xlValues)
Set B = Range6.Find(What:=Employee.Value, LookIn:=xlValues)

If Not A Is Nothing Or Not B Is Nothing Then
Employee.Interior.ColorIndex = 3
End If

Next Employee

Application.ScreenUpdating = True

End Sub

Hope this helps! If it does please give credit.