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?
regards
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?
Code:
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