Sub Macro1()

rowSize = 1
colSize = 1
i = 6
Do While Not IsEmpty(Cells(5, i))
    i = i + 1
    colSize = colSize + 1
Loop

i = 5
Do While Not IsEmpty(Cells(i, 6))
    i = i + 1
    rowSize = rowSize + 1
Loop
rowSize = rowSize - 2
colSize = colSize - 2
Dim MatrixA() As Integer
ReDim MatrixA(rowSize, colSize)

For i = 0 To rowSize
    For j = 0 To colSize
        MatrixA(i, j) = Cells(5 + i, 6 + j)
    Next j
Next i

Dim ArrB() As Integer

Index = 1
For i = 0 To rowSize
    If MatrixA(i, 0) < 10 Then
        ReDim Preserve ArrB(Index)
        ArrB(Index - 1) = MatrixA(i, 0)
        Index = Index + 1
    End If
Next
ReDim Preserve ArrB(Index - 2)

ans = ArrB(0)
ansIndex = -1
For i = 0 To UBound(ArrB)
    Cells(5 + i, 4) = ArrB(i)
    If ans < ArrB(i) Then
        ans = ArrB(i)
        ansIndex = i
    End If
Next
Cells(5, 2) = ans & " " & ansIndex
End Sub