Last active
October 18, 2017 20:48
-
-
Save sinancetinkaya/c34f81f66ab09ca59208a46ed3ff8571 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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