Checking for Duplicate Values across Multiple WorkSheets

[keith0528]

Greetings,

I have some code that compares a particular column "Ticket" across worksheets and hi-lites duplicates in red. The way the code is written it hi-lights all cells in the selected column from the 1st worksheet regardless of dups found. In addition, I need it to add a worksheet and create a report of duplicates found listing sheet name and cell address. Does someone already have something like that?

Sub Highlight_Duplicate()

Dim loop_sheet As Integer
Dim sheet_usedrow As Long
Dim loop_row As Long
Dim compare_value As String
Dim loop_row_first_sheet As Long
Dim first_row_count As Long
Dim column_number As Integer
Dim Found1 As Range
Dim FirstWS As Integer
Dim LastWS As Integer

FirstWS = 1 + 1
LastWS = Worksheets.Count - 2
first_row_count = Sheets(FirstWS).UsedRange.Rows.Count
Sheets(FirstWS).Select
Set Found1 = Cells.Find(What:="Ticket", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
       False, SearchFormat:=False)
       
       Found1.Select
       ColumnNumber = Selection.Column
       column_number = ColumnNumber
 
For loop_row_first_sheet = 2 To first_row_count   'range of sheet
compare_value = Sheets(FirstWS).Cells(loop_row_first_sheet, column_number)

    For loop_sheet = FirstWS To LastWS    'worksheet loop
        sheet_usedrow = Sheets(loop_sheet).UsedRange.Rows.Count
        For loop_row = 2 To sheet_usedrow
            If Sheets(loop_sheet).Cells(loop_row, column_number) = compare_value Then
                Sheets(loop_sheet).Activate
                ActiveSheet.Cells(loop_row, column_number).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
        Next
    Next
    
Next

End Sub

regards