Seleziona Area e calcola Ritardi

Option Explicit
Sub ritardi()
Dim rng_estrazione As Range, rng_tabellone As Range
Dim rng_ritardi As Range, cella As Range, rng_risultati As Range

Dim c_estrazione As Object, tabellone As Object
Dim ritardo As Integer
Dim ur As Long, c As Long, r As Long
 
ur = Cells(Rows.Count, "d").End(xlUp).Row

Set rng_tabellone = Uni0n(Range("i2:i21"), Range("k2:k21"), _
    Range("m2:m21"), Range("o2:o21"), Range("q2:q21"))
Set rng_risultati = Uni0n(Range("j2:j21"), Range("l2:l21"), _
    Range("n2:n21"), Range("p2:p21"), Range("r2:r21"))
    
Set rng_ritardi = Range("c2:h" & ur)
Set rng_estrazione = Range("d1:h1")

Application.ScreenUpdating = False

rng_risultati.ClearContents

For Each cella In rng_ritardi
    If IsNumeric(cella.Value) = False Then
    Else
        Set c_estrazione = rng_estrazione.Find(cella.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c_estrazione Is Nothing Then
            ritardo = 0
        Else
            ritardo = cella.Row - 1
        End If
       
    
        Set tabellone = rng_tabellone.Find(cella.Value, LookIn:=xlValues, lookat:=xlWhole)
        r = tabellone.Row
        c = tabellone.Column
        If Cells(r, c + 1).Value <> "" Then
        Else
            Cells(r, c + 1).Value = ritardo
        End If
    End If
Next cella
Application.ScreenUpdating = True

Set c_estrazione = Nothing
Set tabellone = Nothing
Set rng_ritardi = Nothing
Set rng_estrazione = Nothing
Set rng_tabellone = Nothing
Set rng_risultati = Nothing
End Sub