Faster Method to SUMPRODUCT

[breynolds0431]

Currently, I'm using a =SUMPRODUCT(COUNTIF()) method to build a sequencing of IDs. That is, if there is more than one ID in the range, then a formula assigns a sequence to a column. It takes some time, even when writing the formulas using VBA. Wondering if there's a way to use dictionary or some other memory means of achieving this.

This is what I use to write the formulas to the column. There may be upwards of 100,000 rows that need this formula.

With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
End With
        ws.Range("B13:B" & Range("D" & rows.count).End(xlUp).row).Formula = _
            "=SUMPRODUCT(COUNTIF($D$13:D13,D13))"
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
End With

 

[mikerickson]

If you just need a number to differentiate between duplicate IDs in a different column =ROW() works and is faster than your SUMPRODUCT.

 

[breynolds0431]

The formula, or sequence column, would need to create a sequential numbering of the duplicated ID. Does =ROW() somehow do that with maybe an IF statement?

rand.xlsx
	A	B
1	ID	Sequence
2	DV880442UE	1
3	KP905285NJ	1
4	HR556652HO	1
5	HR556652HO	2
6	LZ855837OU	1
7	TH666004HS	1
8	YB748788CY	1
9	VJ680184JV	1
10	VJ680184JV	2
11	VJ680184JV	3
12	VF962409SU	1
13	HE229935IB	1
14	HR556652HO	3
Sheet1

Cell Formulas
Range	Formula
B2:B14	B2	=SUMPRODUCT(COUNTIF($A$2:A2,A2))

 

[Dave Patton]

Why are you using SumProduct?

Countif or Countifs may suffice.

T202301a.xlsm
	A	B
1	ID	Sequence
2	DV880442UE	1
3	KP905285NJ	1
4	HR556652HO	1
5	HR556652HO	2
6	LZ855837OU	1
7	TH666004HS	1
8	YB748788CY	1
9	VJ680184JV	1
10	VJ680184JV	2
11	VJ680184JV	3
12	VF962409SU	1
13	HE229935IB	1
14	HR556652HO	3
2d

Cell Formulas
Range	Formula
B2:B14	B2	=COUNTIFS($A$2:A2,A2)

 

[breynolds0431]

Why are you using SumProduct?

Countif or Countifs may suffice.

T202301a.xlsm
	A	B
1	ID	Sequence
2	DV880442UE	1
3	KP905285NJ	1
4	HR556652HO	1
5	HR556652HO	2
6	LZ855837OU	1
7	TH666004HS	1
8	YB748788CY	1
9	VJ680184JV	1
10	VJ680184JV	2
11	VJ680184JV	3
12	VF962409SU	1
13	HE229935IB	1
14	HR556652HO	3
2d

Cell Formulas
Range	Formula
B2:B14	B2	=COUNTIFS($A$2:A2,A2)

You're right. SUMPRODUCT doesn't appear to be needed. Not sure where that came from. I removed it but it unfortunately doesn't offer any quicker processing.

 

[Dave Patton]

You can try Countifs; it may be faster.

You could post a concise example of what you are trying to achieve; see the forum's tool XL2BB.
There are new functions in 365 that may help achieve your ultimate result.

 

[breynolds0431]

Appreciate the feedback. Have tried =COUNTIFS, but there's no change in processing. A concise example would be 100,000 rows of the same data that I already posted. I don't think 100,000 rows of XL2BB in this post would be ideal. And this particular workbook would be run in 2016.

The idea would be for the formulas to not take ~60 seconds to complete. I believe the Cells Fill is what takes so long (both by manually autocompleting and by using the Range.Formula = I provided in post #1). So an alternative that would process this in memory would be great if anyone knows of a way.

 

[Alex Blakenburg]

A VBA dictionary solution won't update when you add and delete records but if it is still of interest try this:

Sub Add_SeqNo()

    Dim ws As Worksheet
    Dim rng As Range
    Dim arr As Variant
    Dim lastRow As Long, i As Long, iseq As Long
    Dim dict As Object, dictKey As String
    
    
    Set ws = ActiveSheet
    With ws
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("A2:B" & lastRow)
        arr = rng.Value2
    End With
    
    Set dict = CreateObject("Scripting.dictionary")
    ' Load details into Dictionary and add sequence no
    For i = 1 To UBound(arr)
        dictKey = arr(i, 1)
        If Not dict.exists(dictKey) Then
            iseq = 1
            dict(dictKey) = iseq
        Else
            iseq = dict(dictKey) + 1
            dict(dictKey) = iseq
        End If
        
        arr(i, 2) = dict(dictKey)
    Next i
    
    rng.Columns(2).Value2 = Application.Index(arr, 0, 2)
End Sub

 

[breynolds0431]

A VBA dictionary solution won't update when you add and delete records but if it is still of interest try this:

Sub Add_SeqNo()

    Dim ws As Worksheet
    Dim rng As Range
    Dim arr As Variant
    Dim lastRow As Long, i As Long, iseq As Long
    Dim dict As Object, dictKey As String
   
   
    Set ws = ActiveSheet
    With ws
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("A2:B" & lastRow)
        arr = rng.Value2
    End With
   
    Set dict = CreateObject("Scripting.dictionary")
    ' Load details into Dictionary and add sequence no
    For i = 1 To UBound(arr)
        dictKey = arr(i, 1)
        If Not dict.exists(dictKey) Then
            iseq = 1
            dict(dictKey) = iseq
        Else
            iseq = dict(dictKey) + 1
            dict(dictKey) = iseq
        End If
       
        arr(i, 2) = dict(dictKey)
    Next i
   
    rng.Columns(2).Value2 = Application.Index(arr, 0, 2)
End Sub

That works, thanks! The data would either have new data appended to it or be replaced entirely, which in time I could have the sequencing updated entirely over again.

 

[Alex Blakenburg]

You're welcome. Glad we could help.