Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save sinancetinkaya/c34f81f66ab09ca59208a46ed3ff8571 to your computer and use it in GitHub Desktop.
Save sinancetinkaya/c34f81f66ab09ca59208a46ed3ff8571 to your computer and use it in GitHub Desktop.
Public Col As New Collection
Function Counter(CELL As Range, direction As String)
Dim cell_address As String
cell_address = CELL.Address
new_value = CELL.Value
If cHas(Col, cell_address) Then
arr = cGet(Col, cell_address)
old_value = arr(0)
sum_counter = arr(1)
minus_counter = arr(2)
If new_value > old_value And direction = "+" Then
sum_counter = sum_counter + 1
cSet Col, cell_address, Array(new_value, sum_counter, minus_counter)
Counter = sum_counter
ElseIf new_value < old_value And direction = "-" Then
minus_counter = minus_counter + 1
cSet Col, cell_address, Array(new_value, sum_counter, minus_counter)
Counter = minus_counter
Else
If direction = "+" Then Counter = sum_counter
If direction = "-" Then Counter = minus_counter
End If
Else
cSet Col, cell_address, Array(new_value, 0, 0)
Counter = 0
End If
End Function
'Got VBA Collection functions from there: https://stackoverflow.com/a/30652502/4534316
Private Function cGet(ByRef Col As Collection, Key As String) As Variant
If Not cHas(Col, Key) Then Exit Function
On Error Resume Next
Err.Clear
Set cGet = Col(Key)(1)
If Err.Number = 13 Then
Err.Clear
cGet = Col(Key)(1)
End If
On Error GoTo 0
If Err.Number <> 0 Then Call Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function
Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
If (cHas(Col, Key)) Then Col.Remove Key
Col.Add Array(Key, Item), Key
End Sub
Public Function cHas(Col As Collection, Key As String) As Boolean
cHas = True
On Error Resume Next
Err.Clear
Col (Key)
If Err.Number <> 0 Then
cHas = False
Err.Clear
End If
On Error GoTo 0
End Function
Private Sub cRemove(ByRef Col As Collection, Key As String)
If cHas(Col, Key) Then Col.Remove Key
End Sub
Private Function cKeys(ByRef Col As Collection) As String()
Dim Initialized As Boolean
Dim Keys() As String
For Each Item In Col
If Not Initialized Then
ReDim Preserve Keys(0)
Keys(UBound(Keys)) = Item(0)
Initialized = True
Else
ReDim Preserve Keys(UBound(Keys) + 1)
Keys(UBound(Keys)) = Item(0)
End If
Next Item
cKeys = Keys
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment