Hi Johan,

Am Thu, 7 May 2020 22:13:46 +0200 schrieb Claus Busch:

try this code:

Sub myCount()

better:

Sub myCount()
Dim LRow As Long, i As Long
Dim Last As Long
Dim Res As Integer
Dim myRng As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
LRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For i = 2 To LRow
Last = i - 1 + Application.CountIfs(.Range("N:N"), _
.Cells(i, "N"), .Range("Q:Q"), .Cells(i, "Q"))
myRng = .Range(.Cells(i, "E"), .Cells(Last, "E")).Address
Res = Evaluate("=Sum(1 / CountIf(" & myRng & "," & myRng & "))")
.Range(.Cells(i, "R"), .Cells(Last, "R")) = Res
i = Last
Next
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016