Claus, thx !!

It runs very fast. 13000 records in a few second and the results are correct.
But..... after those 13000 it stops with an error on;
" myRng = .Range(.Cells(i, "E"), .Cells(Last, "E")).Address "

When using your earlier code it stops with an error on;
" Res = Evaluate("=Sum(1 / CountIf(" & myRng & "," & myRng & "))") "

After some investment I see that it stops when the WeekNumber become by the value 18. I'd changed 18 till 17, no problem. I'd changed it to 19... oeps. Everything which is identical/higher in column Q then 18 gives the run error.

regards, Johan