I want to loop through Column A and check if any of the values exist in Column B. I am currently using the .Find function however when I started dealing with large sets of rows (>60 000), it started taking a long time to run the code.
I thought I could create 2 in memory record sets of each column and compare them using .FindFirst but I cannot make it work. I think it is because I am not using any "ADO/DAO" connections since my data are in the workbook itself.
Is there a way to quickly find a match in Column B for each of the values of Column A?
I have tried changing the code to .FindFirst and using recordsets but it keeps saying "The Object does not support property etc...".
For Each cel In rngRD.Cells
With ThisWorkbook.Sheets("RawData").Range("A1:A" & Last_Row_DB)
.Cells(1, 1).Activate
Set CRef = .Find(What:=cel, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If cannot be found then
If CRef Is Nothing Then
'Do Something
Else
Set CRef = .FindNext(CRef)
End If
End With
Next cel
I could not make it work with dictionaries but found another way to do what I needed and the calculation time is very quick for the number of rows >60 000. The best I could do for now!
Sub compareData()
Dim ListA As Range
Dim ListB As Range
Dim c As Range
'Create recordset to hold values to copy
Set rs = New Recordset
With rs
.Fields.Append "ID", adVarChar, 1000, adFldIsNullable
.Fields.Append "Sector", adVarChar, 1000, adFldIsNullable
.Fields.Append "Category", adVarChar, 1000, adFldIsNullable
.Fields.Append "Description", adVarChar, 1000, adFldIsNullable
.Fields.Append "DayNum", adVarChar, 1000, adFldIsNullable
.Fields.Append "Site", adVarChar, 1000, adFldIsNullable
.Fields.Append "Prod", adVarChar, 1000, adFldIsNullable
.Fields.Append "SU", adInteger, , adFldMayBeNull
.Fields.Append "BaseUnit", adInteger, , adFldMayBeNull
.Open
End With
'Define 2 lists to compare (ID's)
ListARange = Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Row 'Find the last row with data on column A
ListBRange = Sheets("RAW DATA").Cells(Rows.Count, "A").End(xlUp).Row 'Find the last row with data on column B
Set ListA = Sheets("DATA").Range("A2:A" & ListARange) 'Set your range only until the last row with data
Set ListB = Sheets("RAW DATA").Range("A2:A" & ListBRange)
'Check if ID already exists in the list, if not, add to recordSet
For Each c In ListB
If Application.CountIf(ListA, c) = 0 Then
rs.AddNew
rs!ID = c
rs!Sector = c.Offset(0, 1)
rs!Category = c.Offset(0, 2)
rs!Description = c.Offset(0, 3)
rs!DayNum = c.Offset(0, 4)
rs!Site = c.Offset(0, 5)
rs!Prod = c.Offset(0, 6)
rs!SU = c.Offset(0, 7)
rs!BaseUnit = c.Offset(0, 8)
rs.Update
End If
Next c