VBA Count first instance only

[Trebor8484]

Hi,

I have a workbook with approximately 500,000 rows which expands each month.

The below code will count each job reference number only once and any subsequent lines for the same reference will return as zero. This code is taking approximately 15 mins to finish the calculation on the column.

Can anyone suggest something that would run quicker please? I have looked into dictionary keys, and wondered if it may be possible to store each unique job reference in memory before outputting the results back to the sheet?

Sub CountFirstInstance()
    
    Dim sht As Worksheet
    
    Set sht = ThisWorkbook.Sheets("Sheet1")
    
    With sht.Range("Q2:Q" & sht.Cells(Rows.Count, "A").End(xlUp).Row)
        .Formula = "=IF(COUNTIF($O$2:O2,O2)=1,1,0)"
    End With
    
    Do Until Application.CalculationState = xlDone
    Loop
    
    With sht.Range("Q2:Q" & sht.Cells(Rows.Count, "A").End(xlUp).Row)
        .Value = .Value
    End With
    
    'Rest of code
    
End Sub

 

[footoo]

Another possibility :
• Filter for unique values
• Go to SpecialCells/Visible and enter 1
• Remove filter, go to SpecialCells/Blanks and enter 0.

 

[Fluff]

How about

Sub Trebor()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long
   
   With ThisWorkbook.Sheets("Sheet1")
      Ary = .Range("O2", .Range("O" & Rows.Count).End(xlUp)).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 1)) Then
            .Add Ary(r, 1), Nothing
            Nary(r, 1) = 1
         Else
            Nary(r, 1) = 0
         End If
      Next r
   End With
   ThisWorkbook.Sheets("Sheet1").Range("Q2").Resize(r).Value = Nary
End Sub

 

[Trebor8484]

Fluff, thanks so much for this. Works perfectly and almost instant.

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[Trebor8484]

Hi, appologies for resurrecting one of my old posts. The code above counts the first instance only to replace a countif formula.

How can i adapt the code to provide a running count instead, for example.

Instead of

=IF(COUNTIF($O$2:O2,O2)=1,1,0)

Running count

=COUNTIF($O$2:O2,O2)

Thanks

 

[Peter_SSs]

Is this what you mean?

Sub Trebor_v2()
   Dim Ary As Variant
   Dim r As Long
   
   With ThisWorkbook.Sheets("Sheet1")
      Ary = .Range("O2", .Range("O" & Rows.Count).End(xlUp)).Value2
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         .Item(Ary(r, 1)) = .Item(Ary(r, 1)) + 1
         Ary(r, 1) = .Item(Ary(r, 1))
      Next r
   End With
   ThisWorkbook.Sheets("Sheet1").Range("Q2").Resize(r).Value = Ary
End Sub

 

[bebo021999]

Sub Trebor()
Dim Ary As Variant, Nary As Variant
Dim r As Long, dic As Object
Set dic = CreateObject("scripting.dictionary")
With ThisWorkbook.Sheets("Sheet1")
    Ary = .Range("O2", .Range("O" & Rows.Count).End(xlUp)).Value2
End With
ReDim Nary(1 To UBound(Ary), 1 To 1)
    For r = 1 To UBound(Ary)
        If Not dic.Exists(Ary(r, 1)) Then
           dic.Add Ary(r, 1), 1
           Nary(r, 1) = 1
         Else
            dic(Ary(r, 1)) = dic(Ary(r, 1)) + 1
            Nary(r, 1) = dic(Ary(r, 1))
         End If
      Next r
ThisWorkbook.Sheets("Sheet1").Range("Q2").Resize(UBound(Nary)).Value = Nary
End Sub

 

[Trebor8484]

Thanks, both pieces of code work perfectly.

 

[Peter_SSs]

You're welcome. Glad we could help.