When I execute the code on more than 10 thousand records it takes approximately 15 to 25 minutes.
This code puts a mark to then make a filter and generate a trend graph with the values 1 and 0.
How could I improve the code so it takes less time to execute?
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
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!