Unique array code DO NOT STOP

[montecarlo2012]

Hi everyone.
After searching this forum and elsewhere, I putting some code together, BUT
Error occurred.
The code run until I forced to stop using, {Ctrl + Shift + Esc } and(End Task) in other words go forever.
And I didn’t see any ms comment about the reason
What I am trying to do is to get a “unique array” on sheet 2
and compare this array, Against sheets 3, 4, 5 and 10

sheet 2 is a dynamic array at (“L2: Q2300”) [at the moment]
All the arrays are DYNAMIC also
Located at:
[at the moment the LastRows are the following]
Sheet 5 (“B2:G2300”)
Sheet 3 (“R1:W34200”)
Sheet 4 (“R1:W35000”)
Sheet 10 (“R1:W900”)

Here it is the code:

Option Explicit
Dim FoundFlag As Boolean    'indicates found match

Dim lastRow As Long, lastrow3 As Long, lastrow4 As Long, lastrow5 As Long, lastrow10 As Long

Dim arry(1 To 6) As Integer
'find duplicates from sheets 3, 4, 5, and 10 that are also
'in sheet2

Private Sub Montecarlo()
Dim sheeet As Integer
Dim i As Long

               Sheets("Sheet2").Activate
               Range("L2").End(xlDown).Select
               lastRow = ActiveCell.row
               
               Sheets("Sheet3").Activate
               Range("R1").End(xlDown).Select
               lastrow3 = ActiveCell.row
               
               Sheets("Sheet4").Activate
               Range("R1").End(xlDown).Select
               lastrow4 = ActiveCell.row
               
               Sheets("Sheet5").Activate
               Range("B2").End(xlDown).Select
               lastrow5 = ActiveCell.row
               
               Sheets("Sheet10").Activate
               Range("R1").End(xlDown).Select
               lastrow10 = ActiveCell.row

Application.ScreenUpdating = False
Application.Calculation = xlManual

            For sheeet = 3 To 10
                     Select Case sheeet
                     Case Is = 3
                     look4dupes sheeet, 0
                     Case Is = 4
                     look4dupes sheeet, 0
                     
                     Case Is = 5
                     look4dupes sheeet, -16
                     Case Is = 10
                     look4dupes sheeet, 0
                     Case Else
                     End Select
                     Sheets(sheeet).Activate
            
            Next
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub

Private Sub look4dupes(shtnum As Integer, offset As Integer)
Dim j As Integer
Dim i As Long, row As Long, fin As Long

               Select Case shtnum
                              Case Is = 3
                              fin = lastrow3
                              Case Is = 4
                              fin = lastrow3
                              
                              Case Is = 5
                              fin = lastrow5
                              Case Is = 10
                              fin = lastrow10
               End Select
    
                  For i = 1 To fin
                           Sheets(shtnum).Activate
                           For j = 1 To 6
                           Cells(i, j + 17 + offset).Select
                           arry(j) = Cells(i, j + 17 + offset)
                  Next
                  CheckWith2
                  Next
    
End Sub

Private Sub CheckWith2()
Dim row2 As Long
Dim i As Long
Dim temp As Integer
Dim CurCol As Integer
Sheets(2).Activate

               For row2 = 2 To lastRow
                           Cells(row2, 12).Select
                           If Cells(row2, 12) = arry(1) Then Exit For
                           Next
               If row2 > lastRow Then Exit Sub
               
               temp = row2
               
               For row2 = temp To lastRow
                           For CurCol = 13 To 12 + 5
                                    Cells(row2, CurCol).Select
                                    If Cells(row2, CurCol) <> arry(CurCol - 11) Then Exit Sub
                                    Next
                           Exit For
               Next

Cells(row2, 18) = "Duplicates "
End Sub

[Note: my PC or my excel 2010 do not support XL2BB, for that reason I can upload any real good example, SORRY]
Thank you for reading this post, I hope to hear about some help, if it is possible, PLEASE.

 

[AlphaFrog]

Your code compares every row on Sheet2 to every row on the four other sheets. That is (2300*2300)+(2300* 34200)+(2300* 35000)+(2300* 900) = 166,520,000 row comparisons. The way you're code does it is expensive. You also .Select cells in your code. That also greatly adds to the expense and is not necessary.

The code below uses arrays and a Dictionary object to identify duplicates. It should be fast.

It logs the duplicate's sheet number and row number. You can also just log the word "Duplicate"

Sub Monty()
    Dim v As Variant, i As Long, strRow As String, n As Variant
    Dim Dic2 As Object
   
    Set Dic2 = CreateObject("Scripting.Dictionary")
    Dic2.CompareMode = 1 'text compare
   
    'Read the values from sheet 2 into an array
    v = Sheets(2).Range("L2", Sheets(2).Range("Q" & Rows.Count).End(xlUp)).Value
   
    'populate the Dictionary with each row of concatenated values
    For i = 1 To UBound(v, 1)
        strRow = Join(Application.Index(v, i, 0), "|") 'Concatenate row values
        Dic2(strRow) = ""
    Next i
   
    'Loop through sheets by index number
    For Each n In Array(3, 4, 5, 10)
       
        'Read a sheet values into an array
        Select Case n
            Case 3, 4, 10
                v = Sheets(n).Range("R2", Sheets(n).Range("W" & Rows.Count).End(xlUp)).Value
            Case 5
                v = Sheets(n).Range("B2", Sheets(n).Range("G" & Rows.Count).End(xlUp)).Value
        End Select
       
        'Identify if a row is duplicated in the Dictionary
        For i = 1 To UBound(v, 1)
            strRow = Join(Application.Index(v, i, 0), "|") 'Concatenate row values
            If Dic2.Exists(strRow) Then
                'Log duplicate
                Dic2(strRow) = "Sheet(" & n & ") Row(" & i + 1 & ")" '"Duplicate"
            End If
        Next i 'next row
       
    Next n 'next sheet
   
    'Output
    Sheets(2).Range("R2").Resize(Dic2.Count).Value = Application.Transpose(Dic2.Items)
   
End Sub

 

[montecarlo2012]

AlphaFrog Thank you for your Code, yes you are right about 166,520,000 row comparisons because even with your Code still I have to stop the process, I wait for 5 minutes and still working.
Yes maybe is to much, Mr. AlphaFrog what about this one, I think I have to try different approach, maybe sheet 2 against sheet 5 in one module, and in another sheet 2 to 3 etc. I test this one, but for some reason nothing happen:

Sub Dupli_Two_five()
    Dim rngFix As Range, rngData As Range, i As Long, lastRow As Long
       
    Set rngFix = Sheets("Sheet5").Range("B2:G2747")
    
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    '/////////////////     IF ANY VALUE FROM SHEET 5 ARE IN SHEET 2 HIGHLIGHT on two  ////
    '///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    
    With Sheets("Sheet2")
        lastRow = .Cells(.Rows.Count, "L").End(xlUp).row
        Set rngData = .Range("L2:Q" & lastRow)
    End With
    For i = 2 To lastRow
        With rngFix
            If Application.CountIfs(.Columns(1), rngData(i, 1), .Columns(2), rngData(i, 2), _
                .Columns(3), rngData(i, 3), .Columns(4), rngData(i, 4), .Columns(5), rngData(i, 5), _
                .Columns(6), rngData(i, 6)) Then
                rngData.Rows(i).Interior.ColorIndex = 6
            End If
        End With
    Next i
End Sub

I tried with a small array and work, but in the real sheets NOT. sorry I am stock.
I will be happy to hear from You again, thank you for reading this post.

 

[AlphaFrog]

AlphaFrog Thank you for your Code, yes you are right about 166,520,000 row comparisons because even with your Code still I have to stop the process, I wait for 5 minutes and still working.

I would expect my code to take only a few seconds at most.

Can you upload an example file to a file share site and post the link here?

 

[montecarlo2012]

Thank you AlphaFrog, I really appreciate you kindness, I am not really able to upload the files. Your code is excellent, I believe my excel has a problem, even trying to upload XL2BB I have an issue so, maybe that is the reason, thank you again and sorry for the inconvenient. I will trying a very basic and ordinary approach,