Cell value(number) increase/decrease counter for P.Action

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

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