Genius Needed: code to find duplicates across tabs

[keith0528]

Greetings,

I have some code that attempts to locate duplicate entries, not within a worksheet, but across worksheets and then post sheet name of found dup in a sheet called "Instructions".

Sub SDupDel()
Dim ColumnNumber1 As Integer
Dim ColumnNumber2 As Integer
Dim Found1 As Range
Dim Found2 As Range
Dim NumtoCol As String
'Application.ScreenUpdating = False
FirstWS = 1 + 1
LastWS = Worksheets.Count - 2
Worksheets(FirstWS).Activate
Set Found1 = Cells.Find(What:="Ticket_Carrier", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
       False, SearchFormat:=False)
       
       Found1.Select
       ColumnNumber1 = Selection.Column
       NumtoCol = ConvertToLetter(ColumnNumber1)
'RI = Range("a65536").End(xlUp).Row
Log1_Range = Range(NumtoCol & "65536").End(xlUp).Row
For WkSht_Range = FirstWS To LastWS                             '<------worksheet loop
    Worksheets(WkSht_Range).Activate
    LI1 = Range(NumtoCol & "65536").End(xlUp).Row
    
    
    For row_number = 2 To Log1_Range                                    '<------row loop
        'Worksheets(FirstWS).Activate
        cell_value1 = Cells(row_number, ColumnNumber1).Value
                
        Next_Sheet = WkSht_Range + 1
        'Worksheets(NI).Activate
        Worksheets(Next_Sheet).Select '   <-------go to next worksheet
        
        Set Found2 = Cells.Find(What:="Ticket_Carrier", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
       
        Found2.Select
        ColumnNumber2 = Selection.Column
        NumtoCol = ConvertToLetter(ColumnNumber2)
        LI2 = Range(NumtoCol & "65536").End(xlUp).Row
        
        j = 2
        
            For i = 2 To LI2
            cell_value2 = Cells(i, ColumnNumber2).Value
                If cell_value2 = cell_value1 Then
                
                
                
                'Place report on Instructions tab
            Sheets("Instructions").Cells(1, 10) = "Duplicates found Across Worksheets"
            RepNum = 2
            
                Sheets("Instructions").Cells(RepNum, 10) = RowNum
                RepNum = RepNum + 1
            Else
                'don't do anything
            End If
                
                
                
                    j = j + 1
                    Worksheets(Next_Sheet).Select
                    
              Next i
            
         Worksheets(WkSht_Range).Select   'go back to 1st sheet being checked
            
    Next row_number
Next WkSht_Range
If WkSht_Range < FirstWS Then
    FirstWS = FirstWS + 1
End If
'Application.ScreenUpdating = True
End Sub

'converts column numbers to letters
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function

I would be very grateful if someone could show me how this code should look.

thank you.

 

[keith0528]

I assume you actually mean tabs in a Workbook?

I don't know how many tabs will be in a given [COLOR=#ff0000]worksheet [/COLOR]so it needs to be flexible. Can you assist me with that?

Try something like this.

Dim wsh As Worksheet

For Each wsh In ThisWorkbook.Sheets
        If wsh.Name <> "Instructions" Then
            
          'Do stuff here

        End If
Next ' wsh

Howard

Yeah, thats what i meant. thanks