I have 3 macros below. I removed some of the newer code from the 1st
macro. The I create two macros to find the threshhold. Modify as
necessary. The first uses just the average to get the trip point. The
2nd uses the average peak to determine the trip point.
My son got laid off from Honeywell yesterday. Do you know of any
contacts for an eager your chemical engineer?
Sub GetHigh()
Const GroupSize = 13
LastRow = Range("AB" & Rows.Count).End(xlUp).Row
MaxCount = 0
FirstRow = 0
LowestAverage = 0
HighestAverage = 0
TotalSum = 0
NumberofSums = 1
'find the hisghest consecuitive 13 numbers by getting the sum of the
values
For RowCount = 2 To (LastRow - GroupSize + 1)
Total = Evaluate("Sum(AB" & RowCount & ":AB" & (RowCount + GroupSize -
1) & ")")
If Total MaxCount Then
FirstRow = RowCount
MaxCount = Total
End If
TotalSum = TotalSum + Total
NumberofSums = NumberofSums + 1
Average = Evaluate("Average(AB" & RowCount & ":AB" & (RowCount +
GroupSize - 1) & ")")
If LowestAverage = 0 Then
LowestAverage = Average
Else
If Average < LowestAverage Then
LowestAverage = Average
End If
If Average HighestAverage Then
HighestAverage = Average
End If
End If
Next RowCount
Set FivePreviousRows = Range("AB" & (FirstRow - 5) & ":AB" & (FirstRow
- 1))
Range("W2") = FivePreviousRows.Address
Set DataRange = Range("AB" & FirstRow & ":AB" & (FirstRow + GroupSize -
1))
Min = WorksheetFunction.Min(DataRange)
Range("W3") = Min
Range("W4") = DataRange.Address
StartRow = FirstRow + GroupSize
EndRow = StartRow + 21
'Don't exceed the length of data
If EndRow LastRow Then
EndRow = LastRow
End If
Set TwentyTwoNextRows = Range("AB" & StartRow & ":AB" & (EndRow))
Range("W5") = TwentyTwoNextRows.Address
'copy data
Range("AB" & (FirstRow - 5) & ":AB" & EndRow).Copy _
Destination:=Range("F4")
Range("T8") = LowestAverage
Range("T9") = HighestAverage
End Sub
Sub GetStartFromAverage()
Const ReferencePoints = 400
Const ComparePoints = 400
Const ThreshHold = 0.9 ' 90% of reference
LastRow = Range("AB" & Rows.Count).End(xlUp).Row
Reference = Evaluate("Average(AB" & (LastRow - ReferencePoints + 1) &
":AB" & LastRow & ")")
TripPoint = Reference * ThreshHold
'get ramp point
For RowCount = (LastRow - ReferencePoints + 1) To 2 Step -1
LocalReference = Evaluate("Average(AB" & RowCount & ":AB" &
(RowCount + ComparePoints - 1) & ")")
If LocalReference <= TripPoint Then
TripRow = RowCount
Exit For
End If
Next RowCount
If TripRow = 0 Then
MsgBox ("Did not find Trip Point")
Exit Sub
End If
Set FivePreviousRows = Range("AB" & (TripRow - 5) & ":AB" & (TripRow -
1))
Range("T7") = FivePreviousRows.Address
Range("T8") = LocalReference
Set TripRange = Range("AB" & TripRow & ":AB" & (TripRow + 12))
Range("T9") = TripRange.Address
Set TwentyTwoNextRows = Range("AB" & (TripRow + 13) & ":AB" & (TripRow
+ 13 + 21))
Range("T10") = TwentyTwoNextRows.Address
'copy data
Range("AB" & (TripRow - 5) & ":AB" & (TripRow + 13 + 21)).Copy _
Destination:=Range("AK2")
End Sub
Sub GetStartFromAveragePeak()
Const ReferencePoints = 400
Const ComparePoints = 400
Const ThreshHold = 0.9 ' 90% of reference
LastRow = Range("AB" & Rows.Count).End(xlUp).Row
Reference = Evaluate("Average(AB" & (LastRow - ReferencePoints + 1) &
":AB" & LastRow & ")")
ReferenceAveragePeak = Evaluate("Average(abs(AB" & (LastRow -
ReferencePoints + 1) & _
":AB" & LastRow & "-" & Reference & "))")
TripPoint = ReferenceAveragePeak * ThreshHold
'get ramp point
For RowCount = (LastRow - ReferencePoints + 1) To 2 Step -1
LocalAverage = Evaluate("Average(AB" & RowCount & ":AB" & (RowCount
+ ComparePoints - 1) & ")")
LocalAveragePeak = Evaluate("Average(abs(AB" & RowCount & _
":AB" & (RowCount + ComparePoints - 1) & "-" & LocalAverage &
"))")
If LocalAveragePeak <= TripPoint Then
TripRow = RowCount
Exit For
End If
Next RowCount
If TripRow = 0 Then
MsgBox ("Did not find Trip Point")
Exit Sub
End If
Set FivePreviousRows = Range("AB" & (TripRow - 5) & ":AB" & (TripRow -
1))
Range("T7") = FivePreviousRows.Address
Range("T8") = LocalAveragePeak
Set TripRange = Range("AB" & TripRow & ":AB" & (TripRow + 12))
Range("T9") = TripRange.Address
Set TwentyTwoNextRows = Range("AB" & (TripRow + 13) & ":AB" & (TripRow
+ 13 + 21))
Range("T10") = TwentyTwoNextRows.Address
'copy data
Range("AB" & (TripRow - 5) & ":AB" & (TripRow + 13 + 21)).Copy _
Destination:=Range("AK2")
End Sub
--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=160004
Microsoft Office Help