Duplicate values across multiple sheets in an excel workbook

[khajduk]

Hi, I am using the code below to attempted to highlight any duplicate phone numbers that would be in column C across multiple sheets in a workbook, however, the code I am using is only highlighting the duplicate number within that particular sheet. Any help would be greatly appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 1 Then Exit Sub

On Error GoTo ErrHandler

Application.ScreenUpdating = False

Dim myDataRng As Range

Dim cell As Range

Set myDataRng = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For Each cell In myDataRng

cell.Offset(0, 0).Font.Color = vbBlack

If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then

cell.Offset(0, 0).Font.Color = vbRed

End If

Next cell

Set myDataRng = Nothing

ErrHandler:

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub

 

[My Aswer Is This]

Do you want to check all sheets at once or as the values are entered into cells in column C

The script you have checks the active sheet as the values are entered not all the sheets at the same time.

And when you say multiple sheets do you mean all sheets if not what are the names of the sheets.

This script will work on all sheets as you enter the values in each sheet.

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Double click on This Workbook

Paste the code in the VBA edit window

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Modified  12/23/2021  12:48:12 AM  EST
If Target.Row = 1 Then Exit Sub

On Error GoTo ErrHandler

Application.ScreenUpdating = False

Dim myDataRng As Range

Dim cell As Range

Set myDataRng = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)

For Each cell In myDataRng

cell.Offset(0, 0).Font.Color = vbBlack

If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then

cell.Offset(0, 0).Font.Color = vbRed

End If

Next cell

Set myDataRng = Nothing

ErrHandler:

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub