Using Find with 2D Arry

Birdie212

New Member
Joined
Jul 4, 2022
Messages
12
Office Version
  1. 2016
Platform
  1. Windows
I have a report that I need to update from the data in another report. Both reports are large, over 50,000 rows, so I read them into arrays so the process would run faster.
I need to split the Source array into separate arrays based on certain conditions in the HR array. I'm getting an object required error when I try to assign a value to the ID variable.
Could anyone help me figure out how to fix this error? Also, am I going about this the right way? Thanks.
Here's my code:

VBA Code:
Option Explicit

Sub SearchArrays()

Dim wb As Workbook, wsSource As Worksheet, wsHR As Worksheet
Dim arrSource() As Variant, arrHR() As Variant, arrNotFound() As Variant, arrRemoved() As Variant, arrUpdated() As Variant
'Dim ID As String
Dim ID As Variant
Dim x As Long, y As Long, nCounter As Long, CounterN As Long, rCounter As Long, CounterR As Long, uCounter As Long, CounterU As Long

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Source")
Set wsHR = wb.Worksheets("HR")

wsSource.Activate
arrSource = Range("A2", Range("A2").End(xlDown).End(xlToRight)) 'Read Source data into array
wsHR.Activate
arrHR = Range("A2", Range("A2").End(xlDown).End(xlToRight))     'Read HR data into array

'Use Find to find the values in source array in the hr array
For x = LBound(arrSource, 1) To UBound(arrSource, 1)
    For y = LBound(arrHR, 1) To UBound(arrHR, 1)
        'ID is in column 2 of Source data and column 3 of HR data
        Set ID = arrSource(x, 2).Find(what:=arrHR(y, 3).Value, LookIn:=xlValues, lookat:=xlWhole)
            If ID Is Nothing Then
                'Copy data to Not Found array
                nCounter = nCounter + 1
                ReDim Preserve arrNotFound(1 To 5, 1 To nCounter)   'Redimension the Not Found array with each instance
                For CounterN = 1 To 5    'The arrNotFound equals the current row
                    arrNotFound(CounterN, nCounter) = arrSource(x, CounterN)
                Next CounterN
            ElseIf Not ID Is Nothing And ID.Offset(, 3).Value <> arrHR(y, 3).Offset(, 2) Then
                'Copy to removed array
                rCounter = rCounter + 1
                ReDim Preserve arrRemoved(1 To 5, 1 To rCounter)   'Redimension the Removed array with each instance
                For CounterR = 1 To 5    'The arrRemoved equals the current row
                    arrRemoved(CounterR, rCounter) = arrSource(x, CounterR)
                Next CounterR
            ElseIf Not ID Is Nothing And ID.Offset(, 3).Value = arrHR(y, 3).Offset(, 2) Then
                'Copy to Updated array
                uCounter = uCounter + 1
                ReDim Preserve arrUpdated(1 To 5, 1 To uCounter)   'Redimension the Updated array with each instance
                For CounterU = 1 To 5    'The arrUpdated equals the current row
                    arrUpdated(CounterU, uCounter) = arrSource(x, CounterU)
                Next CounterU
            End If
    Next y
Next x

'Write arrNotFound to a new worksheet
'Write arrRemoved to a new worksheet
'Write arrUpdated to a new worksheet

End Sub

Sample Data:

NameIDJob TitleSalaryDepartment
Nancy DrewA0001Manager$ 50,000.00Sales
Tom HardyA0002Assistant Manager$ 35,000.00Accounting
Bugs BunnyA0003Director$ 65,000.00PR
Daffy DuckA0004CEO$ 150,000.00Finance
Miss PiggyA0005Engineer$ 55,000.00Technology
Peter ParkerA0006Copy$ 42,000.00Mail Room
Andrea BlueA0007Teller$ 35,000.00Banking
Phil DumpfyA0008Gofer$ 48,000.00Audit
Candy LandA0009Chef$ 200,000.00Kitchen
Larry DoyleA0010Editor$ 22,000.00Staffing
 
UserID in both sheets have no duplicates? so if found, you expect to find only one occurrence per UserID?
Correct. The source file and hr file don't have any duplicates on the UserID field.
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
@Birdie212
Try this:
I assumed:
1. Data on both sheets is sorted ascending by col ID.
2. ID are unique on both sheets.
3. ID in "Source" may not exist in "HR", but ID in "HR" must exist in "Source".

VBA Code:
Sub SearchArrays1()

Dim wb As Workbook, wsSource As Worksheet, wsHR As Worksheet
Dim arrSource() As Variant, arrHR() As Variant, arrNotFound() As Variant, arrRemoved() As Variant, arrUpdated() As Variant
'Dim ID As String
Dim ID As Variant
Dim x As Long, y As Long, nCounter As Long, CounterN As Long, rCounter As Long, CounterR As Long, uCounter As Long, CounterU As Long
Dim z As Long, t

t = Timer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Source")
Set wsHR = wb.Worksheets("HR")

wsSource.Activate
arrSource = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row) 'Read Source data into array

wsHR.Activate
arrHR = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row)    'Read HR data into array


ReDim arrNotFound(1 To UBound(arrSource), 1 To 5)
ReDim arrRemoved(1 To UBound(arrSource), 1 To 5)
ReDim arrUpdated(1 To UBound(arrSource), 1 To 5)
z = 1


For x = LBound(arrSource, 1) To UBound(arrSource, 1)
        'ID is in column 2 of Source data and column 3 of HR data
        If arrSource(x, 2) <> arrHR(z, 3) Then
                nCounter = nCounter + 1
                
                For CounterN = 1 To 5    'The arrNotFound equals the current row
                    arrNotFound(nCounter, CounterN) = arrSource(x, CounterN)
                Next CounterN
            z = z - 1
        Else
            
                If arrSource(x, 5) <> arrHR(z, 5) Then
                    'Copy to removed array
                    rCounter = rCounter + 1
                    For CounterR = 1 To 5    'The arrRemoved equals the current row
                        arrRemoved(rCounter, CounterR) = arrSource(x, CounterR)
                    Next CounterR
                
                Else
                    
                    'Copy to Updated array
                     uCounter = uCounter + 1
                     For CounterU = 1 To 5    'The arrUpdated equals the current row
                         arrUpdated(uCounter, CounterU) = arrSource(x, CounterU)
                     Next CounterU
                End If
        End If
        z = z + 1
    If z > UBound(arrHR) Then z = z - 1
Next x

'Write arrNotFound to a new worksheet
'Write arrRemoved to a new worksheet
'Write arrUpdated to a new worksheet
'put the result
Sheets("Sheet3").Cells.ClearContents
Sheets("Sheet3").Range("A1").Resize(CounterN, 5) = arrNotFound
Sheets("Sheet4").Cells.ClearContents
Sheets("Sheet4").Range("A1").Resize(CounterR, 5) = arrRemoved
Sheets("Sheet5").Cells.ClearContents
Sheets("Sheet5").Range("A1").Resize(uCounter, 5) = arrUpdated

Application.ScreenUpdating = True
Debug.Print "It's done in:  " & Timer - t & " seconds"
End Sub

I'm using this example:
Birdie212 - 1.xlsm
ABCDE
1NameIDJob TitleSalaryDepartment
2Nancy DrewA0001Manager$ 50,000.00Sales
3Tom HardyA0002Assistant Manager$ 35,000.00Accounting
4Bugs BunnyA0003Director$ 65,000.00PR
5Daffy DuckA0004CEO$ 150,000.00Finance
6Miss PiggyA0005Engineer$ 55,000.00Technology
7Peter ParkerA0006Copy$ 42,000.00Mail Room
8Andrea BlueA0007Teller$ 35,000.00Banking
9Phil DumpfyA0008Gofer$ 48,000.00Audit
10Candy LandA0009Chef$ 200,000.00Kitchen
11Larry DoyleA0010Editor$ 22,000.00Staffing
Source


Birdie212 - 1.xlsm
ABCDE
1NameJob TitleIDSalaryDepartment
2Nancy DrewManagerA0001$ 50,000.00Sales
3Tom HardyAssistant ManagerA0002$ 35,000.00xyz
4Daffy DuckCEOA0004$ 150,000.00Finance
5Miss PiggyEngineerA0005$ 55,000.00Technology
6Peter ParkerCopyA0006$ 42,000.00xyz
7Phil DumpfyGoferA0008$ 48,000.00xyx
HR


The workbook:
 
Upvote 0
Sorry. this part:

VBA Code:
Sheets("Sheet3").Cells.ClearContents
Sheets("Sheet3").Range("A1").Resize(CounterN, 5) = arrNotFound
Sheets("Sheet4").Cells.ClearContents
Sheets("Sheet4").Range("A1").Resize(CounterR, 5) = arrRemoved
Sheets("Sheet5").Cells.ClearContents
Sheets("Sheet5").Range("A1").Resize(uCounter, 5) = arrUpdated

should be:
VBA Code:
Sheets("Sheet3").Cells.ClearContents
Sheets("Sheet3").Range("A1").Resize(nCounter, 5) = arrNotFound
Sheets("Sheet4").Cells.ClearContents
Sheets("Sheet4").Range("A1").Resize(rCounter, 5) = arrRemoved
Sheets("Sheet5").Cells.ClearContents
Sheets("Sheet5").Range("A1").Resize(uCounter, 5) = arrUpdated
 
Upvote 0
Dave, here's the code that I executed on the worksheet. I added your suggest to reset the ID to nothing after every For Loop and it still ran for over an hour without completing. Please take a look and see if there is anything wrong with how the code is written. Thanks.

I understand your issue now, its not the range.find method in itself an issue more likely the amount of activity you have going on between sheets & their ranges which on very large data sets best avoided.

Hopefully, potential solution offered by another will resolve your issue but will keep monitoring thread.

Dave
 
Upvote 0
Here's another version, it should be faster.
The code will put some tags, i.e 1,2,3, in Worksheets("Source") col F. You can easily write a code to send data from Worksheets("Source") to other sheets base on the tags.
Note: If you want to re-run the code then don't forget to sort data by ID again.
VBA Code:
Sub SearchArrays2()

Dim wb As Workbook, wsSource As Worksheet, wsHR As Worksheet
Dim arrSource() As Variant, arrHR() As Variant, arrNotFound() As Variant, arrRemoved() As Variant, arrUpdated() As Variant
'Dim ID As String
Dim ID As Variant
Dim x As Long, y As Long, nCounter As Long, CounterN As Long, rCounter As Long, CounterR As Long, uCounter As Long, CounterU As Long
Dim z As Long, h As Long, t, xn

t = Timer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Source")
Set wsHR = wb.Worksheets("HR")

With wsSource
    h = .Range("A" & .Rows.Count).End(xlUp).Row
    arrSource = .Range("A2:E" & h) 'Read Source data into array
End With

With wsHR
    arrHR = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row)    'Read HR data into array
End With
ReDim xn(1 To UBound(arrSource), 1 To 1)
z = 1

For x = LBound(arrSource, 1) To UBound(arrSource, 1)
        'ID is in column 2 of Source data and column 3 of HR data
        If arrSource(x, 2) <> arrHR(z, 3) Then
                xn(x, 1) = 1 'tag
                z = z - 1
        Else
                If arrSource(x, 5) <> arrHR(z, 5) Then
                    xn(x, 1) = 2 'tag
                Else
                    xn(x, 1) = 3 'tag
                End If
        End If
       
        z = z + 1
    If z > UBound(arrHR) Then z = z - 1
Next x

'write tag (xn) in col F & sort data by TAG
With wsSource
.Range("F1") = "TAG"
.Range("F2:F" & h) = xn
.Range("A1:F" & h).Sort Key1:=.Range("F1"), Order1:=xlAscending, Header:=xlYes
End With

'Here you can write a code to send data from Worksheets("Source") to other sheets base on the tag on col F.
'If you want to re-run the code then don't forget to sort data by ID
'...................


Application.ScreenUpdating = True
Debug.Print "It's done in:  " & Format(Timer - t, "0.00000") & " seconds"

End Sub

Using example in post #13, here's the result:
Birdie212 - 1.xlsm
ABCDEF
1NameIDJob TitleSalaryDepartmentTAG
2Bugs BunnyA0003Director$ 65,000.00PR1
3Andrea BlueA0007Teller$ 35,000.00Banking1
4Candy LandA0009Chef$ 200,000.00Kitchen1
5Larry DoyleA0010Editor$ 22,000.00Staffing1
6Tom HardyA0002Assistant Manager$ 35,000.00Accounting2
7Peter ParkerA0006Copy$ 42,000.00Mail Room2
8Phil DumpfyA0008Gofer$ 48,000.00Audit2
9Nancy DrewA0001Manager$ 50,000.00Sales3
10Daffy DuckA0004CEO$ 150,000.00Finance3
11Miss PiggyA0005Engineer$ 55,000.00Technology3
Source
 
Upvote 0
Here's another version, it should be faster.
The code will put some tags, i.e 1,2,3, in Worksheets("Source") col F. You can easily write a code to send data from Worksheets("Source") to other sheets base on the tags.
Note: If you want to re-run the code then don't forget to sort data by ID again.
VBA Code:
Sub SearchArrays2()

Dim wb As Workbook, wsSource As Worksheet, wsHR As Worksheet
Dim arrSource() As Variant, arrHR() As Variant, arrNotFound() As Variant, arrRemoved() As Variant, arrUpdated() As Variant
'Dim ID As String
Dim ID As Variant
Dim x As Long, y As Long, nCounter As Long, CounterN As Long, rCounter As Long, CounterR As Long, uCounter As Long, CounterU As Long
Dim z As Long, h As Long, t, xn

t = Timer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Source")
Set wsHR = wb.Worksheets("HR")

With wsSource
    h = .Range("A" & .Rows.Count).End(xlUp).Row
    arrSource = .Range("A2:E" & h) 'Read Source data into array
End With

With wsHR
    arrHR = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row)    'Read HR data into array
End With
ReDim xn(1 To UBound(arrSource), 1 To 1)
z = 1

For x = LBound(arrSource, 1) To UBound(arrSource, 1)
        'ID is in column 2 of Source data and column 3 of HR data
        If arrSource(x, 2) <> arrHR(z, 3) Then
                xn(x, 1) = 1 'tag
                z = z - 1
        Else
                If arrSource(x, 5) <> arrHR(z, 5) Then
                    xn(x, 1) = 2 'tag
                Else
                    xn(x, 1) = 3 'tag
                End If
        End If
      
        z = z + 1
    If z > UBound(arrHR) Then z = z - 1
Next x

'write tag (xn) in col F & sort data by TAG
With wsSource
.Range("F1") = "TAG"
.Range("F2:F" & h) = xn
.Range("A1:F" & h).Sort Key1:=.Range("F1"), Order1:=xlAscending, Header:=xlYes
End With

'Here you can write a code to send data from Worksheets("Source") to other sheets base on the tag on col F.
'If you want to re-run the code then don't forget to sort data by ID
'...................


Application.ScreenUpdating = True
Debug.Print "It's done in:  " & Format(Timer - t, "0.00000") & " seconds"

End Sub

Using example in post #13, here's the result:
Birdie212 - 1.xlsm
ABCDEF
1NameIDJob TitleSalaryDepartmentTAG
2Bugs BunnyA0003Director$ 65,000.00PR1
3Andrea BlueA0007Teller$ 35,000.00Banking1
4Candy LandA0009Chef$ 200,000.00Kitchen1
5Larry DoyleA0010Editor$ 22,000.00Staffing1
6Tom HardyA0002Assistant Manager$ 35,000.00Accounting2
7Peter ParkerA0006Copy$ 42,000.00Mail Room2
8Phil DumpfyA0008Gofer$ 48,000.00Audit2
9Nancy DrewA0001Manager$ 50,000.00Sales3
10Daffy DuckA0004CEO$ 150,000.00Finance3
11Miss PiggyA0005Engineer$ 55,000.00Technology3
Source
Hi Akuini,
I ran this code against my real data with the Source file and HR file each containing over 50,000 rows. The code completes in about 20 seconds or so. So that's great. The problem is that my tags are returning only 1 or 3 with most of them 1. Which means that the ID is not found in the HR table. I know that's not correct. I visually checked the ids and I see where there are IDs that are returning a tag of 1 that should be 3. I've check both columns in the original files and they are both listed as General data types. I re-wrote the If statement lines using the trim function to remove any possilbe spaces, If Trim(arrSource(x, 2)) <> Trim(arrHR(z, 3)) Then ..., but I get the same results. Do you have any suggestion? Thanks.
 
Upvote 0
1. Using example in post #13, is the result in post #16 correct?
2. Is my assumption correct: ID in "Source" may not exist in "HR", but ID in "HR" must exist in "Source".
3. Could you give me an example that gave you the wrong result?
 
Upvote 0
1. Using example in post #13, is the result in post #16 correct?
2. Is my assumption correct: ID in "Source" may not exist in "HR", but ID in "HR" must exist in "Source".
3. Could you give me an example that gave you the wrong result?
1. Yes this is correct.
2. Yes this is correct.
3. I can't provide you with an example from my live data because I can't share it publicly. The code is working on the sample data provided above just not on the real data that I need to update.
 
Upvote 0
Are you sure both sheets are sort by col ID before you run the code?

3. I can't provide you with an example from my live data because I can't share it publicly. The code is working on the sample data provided above just not on the real data that I need to update.

You can create a dummy data, and it only needs data in col Id & Department, but it needs to give you a wrong result but still meets the 3 criteria, i.e:
1. Data on both sheets is sorted ascending by col ID.
2. ID are unique on both sheets.
3. ID in "Source" may not exist in "HR", but ID in "HR" must exist in "Source".
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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