Excel VBA Countifs with Loops - excel

Question

I'm new to VBA.
I have this formula in Excel in a new column (U) for each row, but takes too long and crashes:
=IF(COUNTIFS($E:$E,E2,$A:$A,"<>"&A2)>0,"Yes","No")
Is there a way to make this in VBA?
Thanks

Answer 1

Based on my understanding of your Excel formula. You are trying to put "Yes" in column U for each row where its value in column E is found elsewhere in Column E, but only if the Column A value is different.
Here is how you would do that in VBA:
Sub Example()
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim LastRow As Integer
LastRow = Sh.Cells(Sh.Rows.Count, "E").End(xlUp).Row
Dim TargetRange As Range
Set TargetRange = Sh.Range("A2:E" & LastRow)
Dim vArr() As Variant
vArr = TargetRange.Value
Dim ColU() As Variant
ReDim ColU(1 To UBound(vArr, 1), 1 To 1)
Dim i As Long
For i = 1 To UBound(vArr, 1)
ColU(i, 1) = "No"
Dim j As Long
For j = 1 To UBound(vArr, 1)
If vArr(i, 5) = vArr(j, 5) And vArr(i, 1) <> vArr(j, 1) Then
ColU(i, 1) = "Yes"
Exit For
End If
Next
Next
Sh.Range("U2").Resize(UBound(vArr, 1)).Value = ColU
End Sub
I first take the values of range A:E into an array. Then I loop through the array checking if my statement is true. If true, "Yes", otherwise default to "No". And then I output the answers to column U.
The downside to this approach is that it is n^2 number of iterations, as I loop through the array for each row of the array. It will be inevitably slow with a very large dataset.
An improvement suggested by #ChrisNeilsen was to start the inner loop from i, cutting the iterations by half. To encorporate this idea, I set up the ColU default values in its own loop first, and then when finding duplicates, I can set both of the duplicates to "Yes" at the same time.
Sub Example()
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim LastRow As Integer
LastRow = Sh.Cells(Sh.Rows.Count, "E").End(xlUp).Row
Dim TargetRange As Range
Set TargetRange = Sh.Range("A2:E" & LastRow)
Dim vArr() As Variant
vArr = TargetRange.Value
Dim ColU() As Variant
ReDim ColU(1 To UBound(vArr, 1), 1 To 1)
Dim i As Long
For i = 1 To UBound(vArr, 1)
ColU(i, 1) = "No"
Next
For i = 1 To UBound(vArr, 1)
Dim j As Long
For j = i To UBound(vArr, 1)
If vArr(i, 5) = vArr(j, 5) And vArr(i, 1) <> vArr(j, 1) Then
ColU(i, 1) = "Yes"
ColU(j, 1) = "Yes"
Exit For
End If
Next
Next
Sh.Range("U2").Resize(UBound(vArr, 1)).Value = ColU
End Sub

Answer 2

Rather than a double loop (which runs in order n^2) another approach that uses a single loop would be to use a lookup instead of the inner loop (this runs in order n, although a little more complex on each iteration).
Something like
Sub Example2()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row
Dim TargetRange As Range
Set TargetRange = ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, 5))
Dim vArr() As Variant
vArr = TargetRange.Value2
Dim ColU() As Variant
ReDim ColU(1 To UBound(vArr, 1), 1 To 1)
Dim i As Long
Dim j As Long
Dim rE As Range
Set rE = ws.Range(ws.Cells(2, 5), ws.Cells(LastRow, 5))
ColU(UBound(vArr, 1), 1) = "No"
For i = 1 To UBound(vArr, 1) - 1
j = 0
On Error Resume Next
j = Application.WorksheetFunction.XMatch(vArr(i, 5), rE.Offset(i, 0), 0, 1)
On Error GoTo 0
ColU(i, 1) = "No"
If j > 0 Then
If vArr(i, 1) <> vArr(j + i, 1) Then
ColU(i, 1) = "Yes"
ColU(j + i, 1) = "Yes"
End If
End If
Next
ws.Range("U2").Resize(UBound(vArr, 1)).Value = ColU
End Sub
On my hardware, a arbitary sample data set ran
Rows
double loop
this code
100
0.015
0.01
1000
0.17
0.03
10000
11.9
0.33
50000
285.0
2.0