Here's my macro
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!
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!