Unique dynamic array require

montecarlo2012

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
984
Office Version
  1. 2010
Platform
  1. Windows
Hi, I have 5 worksheets in my workbook. All of them are alist of numbers on six columns. The goal is make the dynamic Array on Sheet2Unique, in other words, if any row on sheet2 already exist on 3.4.5 or 10 thenhighlight on 2, <o:p></o:p>
Locations:<o:p></o:p>
Sheet2 (L2:Q935)<o:p></o:p>
Sheet3 (I1:N37909)<o:p></o:p>
Sheet4 (J2:O2519)<o:p></o:p>
Sheet5 (B2:G2519)<o:p></o:p>
Sheet10(G1:L1448)
Code: 
Dim LastRow As Long
Dim LastRow3 As Long
Dim LastRow4 As Long
Dim LastRow10 As Long
Dim LastRow5 As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim Arry(6) As Integer[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Private Sub Jeyner()[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim sheeet As Integer
Dim i As Long
Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Sheets("Sheet2").Activate
    Range("l2").End(xlDown).Select
    LastRow = ActiveCell.row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Sheets("Sheet3").Activate
    Range("r1").End(xlDown).Select
    LastRow3 = ActiveCell.row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Sheets("Sheet4").Activate
    Range("b2").End(xlDown).Select
    LastRow4 = ActiveCell.row
    
    Sheets("Sheet5").Activate
    Range("b2").End(xlDown).Select
    LastRow4 = ActiveCell.row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Sheets("Sheet10").Activate
    Range("r1").End(xlDown).Select
    LastRow10 = ActiveCell.row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT] 
[FONT=Calibri][SIZE=3][COLOR=#000000]For sheeet = 3 To 10[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Select Case sheeet
        
               Case Is = 3
                  look4dupes sheeet, 8
               Case Is = 4
                  look4dupes sheeet, 9
               Case Is = 5
                  look4dupes sheeet, 1
               Case Is = 10
                  look4dupes sheeet, 6
               Case Else
               
        End Select
    
    Sheets(sheeet).Activate
                             
    DoEvents
Next[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT] 
[FONT=Calibri][SIZE=3][COLOR=#000000]
End Sub[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Private Sub look4dupes(shtnum As Integer, offset As Integer)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
Dim j As Integer
Dim i As Long, row As Long, fin As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
    Select Case shtnum
        Case Is = 3
            fin = LastRow3
        Case Is = 4
            fin = LastRow4
        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 + offset).Select
            'Arry(j) = Cells(i, j + offset) 'debug here ????
        Next
        DoEvents
        CheckWith2
    Next
    
End Sub[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Private Sub CheckWith2()[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim row2 As Long
Dim i As Long
Dim temp As Integer
Dim CurCol As Integer[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Sheets(2).Activate[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For row2 = 2 To LastRow
        Cells(row2, 12).Select
        If Cells(row2, 12) = Arry(1) Then Exit For
        DoEvents
    Next
    
    If row2 > LastRow Then Exit Sub[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    temp = row2[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    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[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Cells(row2, 18) = "Dup"
Application.ScreenUpdating = True
End Sub
The problem I got with this code is to slow, run for an hour and after give me a error on
Arry(j) = Cells(i, j + offset) 'debug here ????
5 day ago I posted on ozgrid, nobody answer that why after all this time I post here, I hope it is not a problem.

 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
I am really Sorry, Peter. I forgot the link, and I am explained exactly what happen. so the link is:https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1203006-create-a-unique-array. Also here I upload the workbook. I think the code is load wrong so here it is better:
Code: 
Dim LastRow As Long
Dim LastRow3 As Long
Dim LastRow4 As Long
Dim LastRow10 As Long
Dim LastRow5 As Long
Dim Arry(6) As Integer
Private Sub Jeyner()
Dim sheeet As Integer
Dim i As Long
Application.ScreenUpdating = False
    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("b2").End(xlDown).Select
    LastRow4 = ActiveCell.row
    
    Sheets("Sheet5").Activate
    Range("b2").End(xlDown).Select
    LastRow4 = ActiveCell.row
    Sheets("Sheet10").Activate
    Range("r1").End(xlDown).Select
    LastRow10 = ActiveCell.row
 
For sheeet = 3 To 10
        Select Case sheeet
        
               Case Is = 3
                  look4dupes sheeet, 8
               Case Is = 4
                  look4dupes sheeet, 9
               Case Is = 5
                  look4dupes sheeet, 1
               Case Is = 10
                  look4dupes sheeet, 6
               Case Else
               
        End Select
    
    Sheets(sheeet).Activate
                             
    DoEvents
Next
 

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 = LastRow4
        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 + offset).Select
            Arry(j) = Cells(i, j + offset) 'debug here ????
        Next
        DoEvents
        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
        DoEvents
    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) = "Dup"
Application.ScreenUpdating = True
End Sub

Thank you.
 
Last edited by a moderator:
Upvote 0
I have fixed it for you but you need to put your code between the code tags. :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
My code is suddenly really slow
Replies
1
Views
168
RobP
R
L
  • Question
VBA Email extract problem
Replies
0
Views
394
Liverlee
L
C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
K
  • Question
VBA combobox data
Replies
2
Views
364
KingGoku
K
S
  • Question
VBA code help
Replies
2
Views
293
stromnoexcel
S

Forum statistics

Threads
1,215,767
Messages
6,126,781
Members
449,336
Latest member
p17tootie

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top