Passing multiple arguments to a function to check duplicate values from an array - excel

Question

I am trying to count duplicate values from a column range using an array, I created a function that takes 3 arguments, number of rows and 2 strings (Long,String,String) for the comparison. I noticed that it only detects duplicates whenever values are next to each other. I already tried looping from 1 to the last row to make sure that each value will be compared to the rest but I got subscript out of range error.
Here's my code:
Sub CountByErrorTest()
Dim rangeArr() As Variant
Dim tester2 As Worksheet
Set tester2 = Worksheets("tester2")
Dim i As Long, j As Long, lrow As Long
lrow = 3169
rangeArr = Worksheets("tester").Range("a2").Resize(lrow, 29).Value2
For i = 1 To 29
For j = 1 To lrow - 1
If dupVal((rangeArr(j, i)), ((rangeArr(j + 1, i)))) Then
tester2.Range("g4") = tester2.Range("g4") + 1
End If
Next j
Next i
End Sub
My function:
Function dupVal(s1 As String, s2 As String) As Boolean
Dim i As Long
If s1 = s2 Then
dupVal = True
Exit Function
End If
dupVal = False
End Function
I tried looping it like this: Gets out of range error
For k = 1 To lrow - 1
If dupVal((rangeArr(j, i)), ((rangeArr(j + k, i)))) Then
tester2.Range("g4") = tester2.Range("g4") + 1
End If
Next k
I would appreciate suggestions to make it better or if there's an easier way to do it that would be really nice.

Answer 1

The duplicates are only being counted when they are next to each other because of this:
dupVal((rangeArr(j, i)), ((rangeArr(j + 1, i))))
The function goes through the entire range and literally compares each column to that column + 1. So, if there was a duplicate 2 or more columns ago, or 1 or more rows ago, the function would not detect it.
The simplest way to detect duplicates is to build a unique list of the values you do know about. Then, when you encounter a new value as you loop through the range, you compare it to that list (which in this case, is an array). If you find it in the list, you count it as a duplicate, because you've seen it before. Otherwise, it's a new value, so add it to the list. In code, this would be:
Function CountByErrorTest() As Long
Const lcol As Long = 29
Const lrow As Long = 3169
Dim uniqueArr() As Variant, find As Variant
Dim tester1 As Worksheet, tester2 As Worksheet
Dim i As Long, j As Long, k As Long, count As Long, uniqueU As Long
Dim found As Boolean
Set tester1 = Worksheets("tester")
Set tester2 = Worksheets("tester2")
uniqueU = -1
count = 0
ReDim uniqueArr(0)
uniqueArr(0) = Null
'Loop through columns
For i = 1 To lcol
'Loop through rows
For j = 1 To lrow
find = tester1.Cells(j, i).Value
found = False
'Loop through array of unique values
For k = LBound(uniqueArr) To UBound(uniqueArr)
'Check whether this is a known value
If (find = uniqueArr(k)) Then
found = True
Exit For
End If
Next k
If found = True Then
'Count the duplicate
count = count + 1
Else
'Add new value to the array
uniqueU = uniqueU + 1
ReDim Preserve uniqueArr(uniqueU)
uniqueArr(uniqueU) = find
End If
Next j
Next i
tester2.Range("g4").Value = count
CountByErrorTest = count
End Function
If you get to a point where you need to do something like this for a very large range, it may start to get slow. To make it more faster, there are data structures which can be used to more efficiently store and retrieve the unique values as you're checking through the range. Using a binary tree instead of an array would be an example of this.
EDIT: Here's an example of how you can generalise this function to accept a range as a parameter and call it from elsewhere:
Function CountByErrorTest(ByRef tester1 As Worksheet, ByRef tester2 As Worksheet, ByRef range As range) As Long
Dim uniqueArr() As Variant, find As Variant
Dim i As Long, j As Long, k As Long, count As Long, uniqueU As Long, lcols As Long, lrows As Long
Dim found As Boolean
lcols = range.Column + range.Columns.count - 1
lrows = range.Row + range.Rows.count - 1
uniqueU = -1
count = 0
ReDim uniqueArr(0)
uniqueArr(0) = Null
'Loop through columns
For i = range.Column To lcols
'Loop through rows
For j = range.Row To lrows
find = tester1.Cells(j, i).Value
found = False
'Loop through array of unique values
For k = LBound(uniqueArr) To UBound(uniqueArr)
'Check whether this is a known value
If (find = uniqueArr(k)) Then
found = True
Exit For
End If
Next k
If found = True Then
'Count the duplicate
count = count + 1
Else
'Add new value to the array
uniqueU = uniqueU + 1
ReDim Preserve uniqueArr(uniqueU)
uniqueArr(uniqueU) = find
End If
Next j
Next i
CountByErrorTest = count
End Function
Sub ExampleCallFunction()
Dim tester1 As Worksheet, tester2 As Worksheet
Dim range As range
Set tester1 = Worksheets("tester")
Set tester2 = Worksheets("tester2")
Set range = tester2.range("b4:c5") 'set what your range is here
tester2.range("g4").Value = CountByErrorTest(tester1, tester2, range)
End Sub