Sub FindMax()

'Find largest number in B column

i = 1

Do Until i = 4000

If Range("B" & i).Value >= Range("B" & i + 1).Value Then

i = i + 1

Else

imax = Range("B" & i + 1)

icell = i + 1

i = i + 1

End If

Loop

'Find second largest number in B column

i = 2

icell = icell - 1

ifmax = Range("B1").Value

Do Until i = icell

If ifmax >= Range("B" & i + 1).Value Then

i = i + 1

Else

ifmax = Range("B" & i + 1).Value

i = i + 1

End If

Loop

'Find min between two max numbers

i = ifmax

imin = ifmax

Do Until i = icell

If imin > Range("B" & i + 1).Value Then

imin = Range("B" & i + 1).Value

i = i + 1

Else

i = i + 1

End If

Loop

MsgBox ("First max: " & ifmax & " Overall max: " & imax & " Inside min: " & imin)

End Sub

It works for smaller samples, yet keeps screwing up on the blue line in bigger samples for some reason...

any help is appreciated!