how to find largest positive or negative value pattern from a given standpoint - vba

Question

I'm currently writing a sub but I'm unclear of how to approach the problem programatically
Essentially I have a sheet with a column of data values starting at "A1"
How do I write a sub that will check through the column to find the largest pattern starting from the first cell and the direction of the pattern?
ie. if A1 is 2, A2 is 5, A3 is -2 ... the sub should return 2 (positive 2 days in a row)
if A1 is -2, A2 -1, A3 is -5, A4 is -2, A5 -1, A6 2 ... the sub should return -5 (negative 5 days in a row)
What I want is to somehow gather this number but in the process also save the last row in the pattern so I can compute averages, std variation etc. to store to a collection
Here is the code to check for patterns.... the j is a column counter... I need to figure out how to make the loop go back up to right before the for loop instead of iterating the j variable and then going back down....
but in any case here is the check pattern sub
<i> Sub pattern_recogADR()
'add back in as parameters
x As Long
pat_days As Long
sht_start As Long
x = 1
pat_days = 5
sht_start = 13
Dim st As Long
Dim st_num As Long
Dim st_end As Long
Dim count As Long
Dim patrn As Long
count = sht_start
Dim i As Long
Set pat = New pattern
For j = 8 To 12
st_num = 0
If IsNumeric(Cells(count, j).value) Then
st_num = count 'sets default pattern to beginning cell value
If Cells(st_num, j).value < 0 Then
For i = count + 1 To count + 1 + pat_days
If IsNumeric(Cells(i, j).value) And Cells(i, j).value < 0 Then
st_end = i
Else
Exit For
End If
Next i
patrn = st_end - st_num
tix.arbPnl = patrn
'**CONFUSION HERE WANT TO SAVE PATTERN TO AN EXISTING COLLECTION STARTING `
'AT THE FIRST ITEM **
ElseIf Cells(st_num, j).value > 0 Then
For i = count + 1 To count + 1 + pat_days
If IsNumeric(Cells(i, j).value) And Cells(i, j).value < 0 Then
st_end = i
Else
Exit For
End If
Next i
patrn = st_end - st_num
TIX.arbPnl = patrn
'save to separate class for patterns
Else
count = count + 1
End If
Next j
End Sub
Here is where I previously define the object. Basically I want to get this pattern and then add it to the respective attribute (? I dont know coding vocab) in this collection which is already define so the pattern matches with the respective item in the collection.
Option Explicit
Public TixCollection As New Collection
Sub DefineTixCollection()
Application.ScreenUpdating = False
Sheets("Input").Activate
Set TixCollection = Nothing
Dim tix As clsTix
Dim i As Long
Dim last_row As Long
last_row = Range("A" & Rows.count).End(xlUp).Row
'Add tix properties
For i = 3 To last_row
Set tix = New clsTix
'only adds active tickers to collection
If Range("A" & i).value = "x" Then
'Random data
tix.ORD = Range("B" & i).value
tix.ADR = Range("C" & i).value
tix.ratio = Range("D" & i).value
tix.crrncy = Range("E" & i).value
tix.hedge_index = Range("F" & i).value
tix.hedge_ord = Range("G" & i).value
tix.hedge_ratio = Range("H" & i).value
' ADR is the id key
TixCollection.Add tix, tix.ADR
End If
Next i
' Error Check
' For i = 1 To 5
' 'retrieve by collection index
' Debug.Print TixCollection(i).ORD
' Debug.Print TixCollection(5).ADR
' Debug.Print TixCollection(5).ratio
' Debug.Print TixCollection(i).crrncy
' Debug.Print TixCollection(i).hedge_index
' Debug.Print TixCollection(i).hedge_ord
' Debug.Print TixCollection(i).hedge_ratio
' Next i
End Sub
Any help would be much appreciated getting frustrated now... ugh

Answer 1

Sub Button1_Click()
Dim patrn() As Long
ReDim patrn(0 To 4)
Dim count As Long
Dim posCount As Integer
Dim negCount As Integer
Dim sign As Boolean
posCount = 0
negCount = 0
count = 0
Dim i As Long
Dim j As Integer
Dim lastRow As Long
For j = 8 To 12
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.count, j).End(xlUp).Row
For i = 1 To lastRow
If IsNumeric(Cells(i, j).Value) Then
If count = 0 Then
If Cells(i, j).Value > 0 Then
sign = True
posCount = posCount + 1
ElseIf Cells(i, j).Value < 0 Then
sign = False
negCount = negCount + 1
End If
ElseIf count > 0 And count <= 4 Then
If Cells(i, j).Value > 0 And sign = True Then
sign = True
posCount = posCount + 1
ElseIf Cells(i, j).Value > 0 And sign = False Then
sign = True
posCount = 1
ElseIf Cells(i, j).Value < 0 And sign = True Then
sign = False
negCount = 1
ElseIf Cells(i, j).Value < 0 And sign = False Then
sign = False
negCount = negCount + 1
End If
ElseIf count = 5 Then
Exit For
End If
count = count + 1
End If
Next i
If posCount > negCount Then
patrn(j - 8) = posCount
Else
patrn(j - 8) = negCount - (negCount * 2)
End If
negCount = 0
posCount = 0
count = 0
Next j
'Do your other calculations here.
For i = LBound(patrn) To UBound(patrn)
Debug.Print patrn(i)
Next
End Sub