Modificar macro de arriba hacia abajo

Para dante amor:

Maestro dante como puedo añadirle al siguiente código para que me realice también una búsqueda del numero en la dirección de arriba a abajo

Sub sopa_de_Numeros()
'
' Por.Dante Amor
'
'
Application.ScreenUpdating = False
'
'obiene ls cuadros
Dim cuadros As New Collection
Set cuadros = Nothing
uu = Range("G" & Rows.Count).End(xlUp).Row
For jj = Columns("G").Column To Columns("BK").Column Step 14
For ii = 2 To uu Step 14
If Cells(ii, jj) = "" Then
Exit For
End If
'rango = Cells(ii, jj).Address
cuadros.Add Cells(ii, jj).Address
Next
Next
'
Columns("G:BP").Interior.ColorIndex = xlNone
'En cada cuadro busca cada número
For q = 1 To cuadros.Count
Set R = Range(cuadros(q)).Resize(12, 12)
'r.Interior.ColorIndex = xlNone
'solamente busca de izq - der
kes = Array(3, 4)
For i = 2 To Range("BM" & Rows.Count).End(xlUp).Row
num = Cells(i, "BM") & Cells(i, "BN") & Cells(i, "BO") & Cells(i, "BP")
If IsNumeric(num) Then
Set b = R.Find(Left(num, 1), LookAt:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
For K = LBound(kes) To UBound(kes)
resto = Mid(num, 2, Len(num))
If buscar(R, resto, kes(K), b.Row, b.Column, False) Then
pintar = buscar(R, resto, kes(K), b.Row, b.Column, True)
Range(Cells(i, "BM"), Cells(i, "BP")).Interior.ColorIndex = 6
Exit Do
End If
Next
Set b = R.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End If
Next
Next
Set b = Nothing
Set R = Nothing
Set cuadros = Nothing
End Sub
'
Function buscar(R, resto, K, f, c, si)
'por.Dante Amor
For i = 1 To IIf(si, Len(resto) + 1, Len(resto))
If si Then Cells(f, c).Interior.ColorIndex = 6
Select Case K
Case 1: f = f - 1: c = c + 0 'aba - arr
Case 2: f = f - 1: c = c + 1 'izq - der, aba - arr
Case 3: f = f + 0: c = c + 1 'izq - der *
Case 4: f = f + 1: c = c + 1 'arr - aba, izq - der *
Case 5: f = f + 1: c = c + 0 'arr - aba
Case 6: f = f + 1: c = c - 1 'arr - aba, der - izq
Case 7: f = f + 0: c = c - 1 'der - izq
Case 8: f = f - 1: c = c - 1 'der - izq, aba - arr
End Select
If f >= R.Rows(1).Row And f <= R.Rows(R.Rows.Count).Row _
And c >= R.Columns(1).Column And c <= R.Columns(R.Columns.Count).Column Then
If IsNumeric(Mid(resto, i, 1)) Then
Valor = Val(Mid(resto, i, 1))
If Cells(f, c) <> "" Then
valcelda = Val(Cells(f, c))
If valcelda = Valor Then
continua = True
Else
continua = False
Exit For
End If
Else
continua = False
Exit For
End If
Else
continua = False
Exit For
End If
Else
continua = False
Exit For
End If
Next
buscar = continua
End Function