Does this help?
Option Explicit
Sub FindMaxForce()
Dim Col As Integer
Dim Row As Integer
Dim b As Integer
Dim CellBefore As Range
Dim CellMid As Range
Dim CellAfter As Range
b = 1
For Col = 1 To 3
' MsgBox col
For Row = 1 To 10
Set CellBefore = Worksheets("Sheet1").Cells(1, Col).Offset(Row - 1, 0)
Set CellMid = Worksheets("Sheet1").Cells(1, Col).Offset(Row, 0)
Set CellAfter = Worksheets("Sheet1").Cells(1, Col).Offset(Row + 1, 0)
If CellMid = "" Then GoTo a:
If CellMid >= CellBefore And CellMid >= CellAfter And CellMid >= 30 Then
'Cells(b, 3) = CellMid
Worksheets("sheet2").Range("a" & b).Value = CellMid
b = b + 1
CellBefore.Activate
End If
Next Row
a:
Next
End Sub
Bookmarks