How to improve VBA EXCEL code sum product-CodePudding

I hope you can help me to optimize this code block in VBA EXCEL. When I execute the block of code with less than two thousand records, it takes between one minute to 3 minutes to execute, but the problem arises when I have to execute the code when there are more than 10 thousand records and in that case it takes approximately 15 to 25 minutes to work.

What this code does is put a mark to then make a filter and generate a trend graph with the values 1 and 0.

How could I improve that line so that it takes less time to execute?

Thank you very much for your support

Sub Flags()

Dim wSht As Worksheet
Set wSht = ActiveSheet

'New_Columns_Calculation

    With wSht.Range("HI2:HI" & wSht.Cells(Rows.Count, "HH").End(xlUp).Row)
        .Formula = "=IF(SUMPRODUCT(($HF$2:HF2=HF2) * ($HG$2:HG2=HG2))>1,0,1)"
        .Value = .Value 'We convert the formula to values
    End With
    
End Sub

CodePudding user response：

I had a go at a few different things here (turning calculations off and splitting the formula and value past as well as doing this as a VBA operation).

Honestly none of them availed much on my test set (two columns of 20,000 random numbers).

This being said I think it might be worth you trying the array option; full disclosure this was slower on my test than your code but I think will be less susceptible to the problem of having so many columns of data as you do.

obviously only do this on a test data set and validate to your code to ensure its working

Sub FlagsArray()

    Dim wSht As Worksheet, rng As Range, myArray(), arrayOut() As Variant
    Set wSht = ActiveSheet
    Set rng = wSht.Range("A2:B" & wSht.Cells(Rows.Count, "A").End(xlUp).Row)
    
    myArray = rng.Value
    ReDim arrayOut(1 To UBound(myArray), 0)
    
    
    arrayOut(1, 0) = 1
    
    For i = 2 To UBound(myArray)
        arrayOut(i, 0) = 1
        For j = 1 To i - 1
            If myArray(j, 1) = myArray(i, 1) And myArray(j, 2) = myArray(i, 2) Then
                arrayOut(i, 0) = 0
                Exit For
            End If
        Next j
    Next i
    
    wSht.Range("C2:C" & wSht.Cells(Rows.Count, "A").End(xlUp).Row) = arrayOut()

End Sub

Please let me know how you get on with this as I'm amazed I couldn't make more progress on this one and I'm holding out hope that this works on the bigger set you have!