verifica corrispondenza codici e cerca un numero

Sub Corrispondenza()
Dim ur As Long, rp As String, rt As String, ps As Integer, rng As Range, riga As Integer
ur = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("J1:J51")
Application.Calculation = xlCalculationManual
For j = 2 To ur
    rp = Cells(j, 1)
    rt = Left(rp, 2)
    ps = Right(rp, 1)
    riga = Application.WorksheetFunction.Match(rt, rng, 0)
    For i = riga To riga + 4
        If Cells(i, 8) = ps Then
            Cells(j, 2) = Cells(i, 9)
            Exit For
        End If
    Next i
Next j
Application.Calculation = xlCalculationAutomatic
msgbox "Done!"
End Sub

Sub RicPos() 'ricerca Posizione
Dim r, c, d, p, n, x, y, rn1, rn2, arr1, Fine As Double, Inizio As Double

r = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2:B" & r).ClearContents
rn1 = Range("A2:A" & r)
Application.ScreenUpdating = False
Inizio = Timer
arr1 = Range("BA2:BA56")
r = Cells(Rows.Count, 9).End(xlUp).Row
rn2 = Range("I1:I" & r)
For y = 1 To UBound(rn2)
  n = rn2(y, 1)
  p = arr1(y, 1)
  For x = 1 To UBound(rn1)
    If rn1(x, 1) = p Then
      Cells(x + 1, 2) = n
    End If
  Next x
Next y
Cells(1, 1).Select
Application.ScreenUpdating = True
Fine = Timer
MsgBox ("Tempo impiegato " & Round((Fine - Inizio), 2) & " secondi")
End Sub

Sub RicPos() 'ricerca Posizione
Dim r, c, d, p, n, x, y, rn1, rn2, arr1, Fine As Double, Inizio As Double

Application.Calculation = xlCalculationManual 'blocca le formule
r = Cells(Rows.Count, 1).End(xlUp).Row 'ultima riga colonna A
Range("B2:B" & r).ClearContents 'pulisce dati in colonna B
rn1 = Range("A2:A" & r) 'prende tutti i dati della colonna A
Application.ScreenUpdating = False 'blocca lo scermo
Inizio = Timer 'inizializza cronometro
arr1 = Range("BA2:BA56") 'prende le sigle delle ruote
r = Cells(Rows.Count, 9).End(xlUp).Row 'ultima riga colonna H
rn2 = Range("I1:I" & r) 'prende estrazione colonna H
For y = 1 To UBound(rn2) '1° ciclo scorre i numeri dell'estrazione
  n = rn2(y, 1) 'numero dell'estrazione
  p = arr1(y, 1) 'sigla dell'estrazione "Ba1-2-3-etc" Array colonna BA
  For x = 1 To UBound(rn1) '2° ciclo scorre la colonna A
    If rn1(x, 1) = p Then 'confronta la sigla colonna A con la sigla dell'estrazione
      Cells(x + 1, 2) = n 'ogni volta che la trova scrive il numero in colonna B
    End If
  Next x
Next y
'chiusura seleziona la cella A1 e rispristina lo schermo e il calcolo delle formule
'riportando il tempo impiegato
Cells(1, 1).Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Fine = Timer
MsgBox ("Tempo impiegato " & Round((Fine - Inizio), 2) & " secondi")
End Sub

Function Fuori90(ff) 'questa la funzione per il fuori90

While ff > 90
    ff = ff - 90
Wend
If ff = 0 Then ff = 90
Fuori90 = ff
End Function

Function Vert90(n) 'questa per i vertibili con il fuori90
Dim vv
While n > 90
    n = n - 90
Wend
If n = 0 Then n = 90
vv = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 1, 19, 21, 31, 41, 51, 61, 71, 81, 11, 2, 12, 29, 32, 42, 52, 62, 72, 82, 22, 3 _
            , 13, 23, 39, 43, 53, 63, 73, 83, 33, 4, 14, 24, 34, 49, 54, 64, 74, 84, 44, 5, 15, 25, 35, 45, 59, 65, 75, 85, 55 _
            , 6, 16, 26, 36, 46, 56, 69, 76, 86, 66, 7, 17, 27, 37, 47, 57, 67, 79, 87, 77, 8, 18, 28, 38, 48, 58, 68, 78, 89 _
            , 88, 9)
Vert90 = vv(n - 1)
End Function