Search using two ranges

[pathfinder73]

I need a function where I would be informed: two cells that delimit a range with values to be searched; two cells that inform a range where the values of the first range are to be searched.
The function will return the number of localized values.

Values are unique in both ranges.

It may seem simple, but this worksheet has more than a million lines, and with this code I hope to erase many of them.

Thanks a lot!

: pray2:

[SamT]

Do you want
For each cell in Range 1
Find matches in Range 2
And count the total matches found?
Or, delete the Matches found in Range X?
Or, Combine the two Ranges into a single range with unique values?

Do you need to do this often, or just this one time?

[pathfinder73]

Do you want
For each cell in Range 1
Find matches in Range 2
And count the total matches found?
Or, delete the Matches found in Range X?
Or, Combine the two Ranges into a single range with unique values?

Do you need to do this often, or just this one time?


Only count and show total sum.

This need will be frequently.

[SamT]

worksheet has more than a million lines ... Only count and show total sum.
Then Arrays are the answer for speed


Option Explicit

'--------------------------------------------------------------------------
Sub SetRanges()
'You may need to write some code to set the ranges.
'I'm just providing a stub, just in case.
'
'You will need to edit the column assignements in this

Dim Rng1 As Range
Dim Rng2 As Range
Dim Result As Long

Set Rng1 = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
Set Rng2 = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp))

Result = CountDuplicates(Rng1, Rng2)

MsgBox Result & " Duplicates Found"
End Sub
'----------------------------------------------------------------------------------------


Function CountDuplicates(Rng1 As Range, Rng2 As Range) As Long
'Assumes all values in Rng1 and in Rng2 are unique

Dim Arr1 As Variant, Arr2 As Variant
Dim i As Long, j As Long
Dim DupesCount As Long

Arr1 = WorksheetFunction.Transpose(Rng1.Value) 'Coders Note: See array Subscripts below
Arr2 = Rng2.Value

For i = LBound(Arr1) To UBound(Arr1)
For j = LBound(Arr2, 1) To UBound(Arr2, 1)
If Arr1(i) = Arr2(j, 1) Then
DupesCount = DupesCount + 1
Exit For 'Found the unique duplicate, no need to continue
End If
Next j
Next i

CountDuplicates = DupesCount

End Function

[pathfinder73]

:bow:

Question solved.