Option Explicit
Sub GPEExtremum()
Dim mRng As Range, Sh As Worksheet, Rng As Range, Clls As Range
Dim Frame As String
Dim eRw As Long, Station As Double, Min_ As Double, Max_ As Double
Sheets("Element Forces - Frames").Select: eRw = [A65500].End(xlUp).Row
Set Rng = [a4].Resize(eRw - 3, 7): Set Sh = Sheet2
[A1].Resize(4, 3).Copy Destination:=Sh.[A1]
Sh.[A5].Resize(eRw, 4).Clear
[g3].Resize(2).Copy Destination:=Sh.[c3]
Rng.Sort Key1:=[A5], Order1:=xlAscending, Key2:=[B5], Order2:=1, Header:=xlGuess
For Each Clls In Rng.Cells(2, 1).Resize(eRw)
If Clls.Row = 5 Then
Set mRng = Clls.Offset(6): Frame = Clls.Value
Station = Clls.Offset(, 1).Value
Else
If Clls.Offset(, 1).Value = Station And Clls.Value = Frame Then '<=|'
Set mRng = Union(mRng, Clls.Offset(, 6))
9 ElseIf Clls.Offset(, 1).Value <> Station Or _
(Clls.Offset(, 1).Value = Station And Clls.Value <> Frame) Then
With Application.WorksheetFunction
Min_ = .Min(mRng): Max_ = .Max(mRng)
End With
If Abs(Min_) > Max_ Then Max_ = Min_
With Sh.[A65500].End(xlUp).Offset(1)
.Value = Frame: .Offset(, 1).Value = Station
.Offset(, 2).Value = Max_
End With
Frame = Clls.Value: Station = Clls.Offset(, 1).Value
Set mRng = Clls.Offset(, 6)
End If
End If
Next Clls
MsgBox mRng.Address
Sh.Select
End Sub
