Hi Kyle

Hopefully we are getting closer. This part

"if active row high greater than old high then active row becomes new
high "

has always been true the model does this.

The second part now

or if ((new high - active row low) < -.0033) then subtract newhigh
from the
trough before it.

Do you mean subtract the newhigh from the newtrough. This will cause
odd results so I put

The Active Row high less the NewTrough.

This is the line you will want to play with

CatchP = .Cells(i, ARH) - NewTrough
CatchT = .Cells(i, ARL) - NewPeak

These two lines control the second part of the equation. Let me know
what these should be if this version of the algorithm is not getting
the job done. If you change this to

CatchP = NewPeak - NewTrough
CatchT =NewTrough - NewPeak

You will see the results look very wrong. Let me know how this next
stab goes.

Take care

Marcus



Full code below.

Option Explicit

Sub HighLow()

Dim Res As Long
Dim InRow As Long
Dim ws As Worksheet
Dim EndRow As Long
Dim ARH As Long
Dim ARL As Long
Dim i As Long
Dim sp As Double
Dim Peak As Double
Dim Trough As Double
Dim NewPeak As Double
Dim NewTrough As Double
Dim CatchP As Double
Dim CatchT As Double

Set ws = ActiveSheet
EndRow = Range("A65536").End(xlUp).Row
InRow = 2 'First Row of data
ARH = 4
ARL = 5
Res = 9 'Result column

With ws
sp = .Cells(2, 3).Value
For i = InRow To EndRow
'if ((new high - active row low) < -.0033) then subtract newhigh
from the trough before it.

Peak = .Cells(i, ARH) - sp
Trough = .Cells(i, ARL) - sp
CatchP = .Cells(i, ARH) - NewTrough
CatchT = .Cells(i, ARL) - NewPeak
'Peak Part
If Peak 0.0033 Or CatchP 0.0033 And CatchP < 1 Then
.Cells(i, Res) = "Peak"
NewPeak = MyMax(Range(Cells(InRow, ARH), Cells(i, ARH)))
If .Cells(i, ARH) = NewPeak Then
.Cells(i, Res) = "NewPeak"
If NewPeak - NewTrough 1 Then 'Handle 0 for NewTrough
.Cells(i, Res + 1) = NewPeak - sp
Else
.Cells(i, Res + 1) = NewPeak - NewTrough
End If
End If
' Trough Part
ElseIf Trough < -0.0033 Or CatchT < -0.0033 And CatchT < 1 Then
.Cells(i, Res) = "Trough"
NewTrough = MyMin(Range(Cells(InRow, ARL), Cells(i, ARL)))
If .Cells(i, ARL) <= NewTrough Then
.Cells(i, Res) = "NewTrough"
If NewTrough - NewPeak 1 Then 'Handle 0 for NewPeak
.Cells(i, Res + 1) = NewTrough - sp
Else
.Cells(i, Res + 1) = NewTrough - NewPeak
End If
' sp = NewTrough
End If
Else 'Handle neither
.Cells(i, Res) = ""
End If
Next i
End With
End Sub
Function MyMax(MyRng As Range)
MyMax = WorksheetFunction.Max(MyRng)
End Function

Function MyMin(MyRng As Range)
MyMin = WorksheetFunction.Min(MyRng)
End Function