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

CodePudding user response：

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

CodePudding user response：

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