Excel: Genius Needed: code to find duplicates across tabs


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.


This question generated 21 answers. To proceed to the answers, click here.

This thread is current as of June 25, 2014.


For more resources for Microsoft Excel