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
 
One more thing:
In your actual data, is the ID just numbers and has zero in the beginning? such as 0012 or 0234.
 
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Could you reply to my question in post #20?
 
Upvote 0
Could you reply to my question in post #20?
I though I replied to this yesterday.

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".

1. Yes
2. Yes
3. Yes

I'm working on the test of the dummy data.
 
Upvote 0
Akuini, I just realized that I answered #3 above incorrectly. There are IDs in Source that are not in HR. I'm trying to identify those so they can be removed from the list. But there are also IDs in HR that are not in Source. Those are new employees that I need to add to the Source. That's the next step in the process. Sorry for the confusion. That's what's causing the issue. I stepped through the code using F8 and when the code comes across an ID in HR that's not in Source it assigns a 1 to xn then moves to the next row in Source.
 
Upvote 0
But there are also IDs in HR that are not in Source.
Ok, try this one:
Condition:
1. Data on both sheets is sorted ascending by col ID.
2. ID are unique on both sheets.

VBA Code:
Sub SearchArrays3()

Dim wb As Workbook, wsSource As Worksheet, wsHR As Worksheet
Dim arrSource() As Variant, arrHR() As Variant
Dim x As Long, y As Long, j As Long, k As Long, i As Long
Dim t, xn, xy

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

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

With wsHR
    k = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    arrHR = .Range("A2:E" & k)    'Read HR data into array
End With

arrSource(j - 1, 2) = "zzzz"
arrHR(k - 1, 3) = "zzzz"

ReDim xn(1 To UBound(arrSource), 1 To 1)
ReDim xy(1 To UBound(arrHR), 1 To 1)

x = 1
y = 1

Do
    If arrSource(x, 2) = arrHR(y, 3) Then 'ID exist in Source and HR
        
        If arrSource(x, 5) <> arrHR(y, 5) Then
            xn(x, 1) = "DD" 'tag, different DEPT
        Else
            xn(x, 1) = "SD" 'tag, same DEPT
        End If

        x = x + 1
        y = y + 1
    
    ElseIf arrSource(x, 2) < arrHR(y, 3) Then
        
        xn(x, 1) = "S" 'tag, 'ID exist in Source but not in HR
        x = x + 1
    
    Else
        
        xy(y, 1) = "H" 'tag, 'ID exist in HR but not in Source
        y = y + 1
    
    End If
        
Loop Until x > UBound(arrSource, 1) And y > UBound(arrHR, 1)

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

'write tag (xy) in col F sheet "HR" & sort data by TAG
With wsHR
    .Range("F1") = "TAG"
    .Range("F2:F" & k - 1) = xy
    
    'sort data by tag
    '.Range("A1:F" & k - 1).Sort Key1:=.Range("F1"), Order1:=xlAscending, Header:=xlYes
End With

'Here you can write x 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

I'm using this example, the result are in col F on both sheets:

Birdie212 - 2.xlsm
ABCDEF
1NameIDJob TitleSalaryDepartmentTAG
2Nancy DrewA0001Manager$ 50,000.00SalesSD
3Tom HardyA0002Assistant Manager$ 35,000.00AccountingDD
4Daffy DuckA0004CEO$ 150,000.00FinanceSD
5Miss PiggyA0005Engineer$ 55,000.00TechnologySD
6Peter ParkerA0006Copy$ 42,000.00Mail RoomDD
7Andrea BlueA0007Teller$ 35,000.00BankingS
8Phil DumpfyA0008Gofer$ 48,000.00AuditDD
9Candy LandA0009Chef$ 200,000.00KitchenS
10Larry DoyleA0011Editor$ 22,000.00StaffingS
11Bugs BunnyA0012Director$ 65,000.00PRS
Source


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


TAGS:
DD = ID exist in Source and HR, different DEPT
SD = ID exist in Source and HR, same DEPT
S = ID exist in Source only
H = ID exist in HR only
 
Upvote 0
@Birdie212
I just found out something, sorting pattern in Excel is actually not as simple as I thought, regarding case sensitive & insensitive sorting. If "ID" in your data are all upper case or all are lower case then my code would work, but if it is combination of upper case & lower case then it could give you incorrect result.
So, if "ID" in your actual data is combination of upper case & lower case, such as "Aa01", "ab01", then you'll need different code, perhaps by using dictionary object.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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