Count consecutive negative numbers

[Godwin117]

I am looking for a formula or vba, whichever is easier, where if the value in the row is negative, it will count until the next 0 or positive number, for the whole column. An example is below. I searched and couldn't find the exact thing I was looking for. Any help will be greatly appreciated.

Original Data	Consecutive negative numbers
1	0
-2	1
0	0
-1	3
-1	2
-2	1
3	0
2	0

 

[kennypete]

Hi @Godwin117, I have tested this and it works as you want it to:

Option Explicit

Sub CountCumulativeNegatives()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
       
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange
   
    Dim cnt As Long
    cnt = rng.Rows.Count
   
    Dim con As Long
    con = 0
       
    Dim loo As Long, lo2 As Long
    For loo = 2 To cnt
        If Cells(loo, 1).Value < 0 Then
            dic.Add key:=loo, Item:=1
            If con > 0 Then
                For lo2 = con To 1 Step -1
                    dic(loo - lo2) = dic(loo - lo2) + 1
                Next lo2
            End If
            con = con + 1
        Else
            dic.Add key:=loo, Item:=0
            con = 0
        End If
    Next loo
   
    Dim key As Variant
    For Each key In dic.Keys
    '    Debug.Print key, ":", dic(key)
        Cells(key, 2) = dic(key)
    Next key
   
End Sub

It requires the data to be in column A and the output to column B, but could be easily adjusted. It also presumes the active sheet is the input.

The logic could be better - e.g. working backwards up column A would actually be easier, but I was done before I thought about doing that.

 

[kennypete]

Indeed, here's the simpler version, which you may prefer (unless you have another use for the dictionary in V1):

Sub CountCumulativeNegativesV2()
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange
    Dim cnt As Long
    cnt = rng.Rows.Count
    Dim con As Long
    con = 0
        
    Dim loo As Long
    For loo = cnt To 2 Step -1
        If Cells(loo, 1).Value < 0 Then
            Cells(loo, 2) = Cells(loo + 1, 2).Value + 1
        Else
            Cells(loo, 2) = 0
        End If
    Next loo
    
End Sub

 

[Godwin117]

Hi @Godwin117, I have tested this and it works as you want it to:

Option Explicit

Sub CountCumulativeNegatives()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
      
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange
  
    Dim cnt As Long
    cnt = rng.Rows.Count
  
    Dim con As Long
    con = 0
      
    Dim loo As Long, lo2 As Long
    For loo = 2 To cnt
        If Cells(loo, 1).Value < 0 Then
            dic.Add key:=loo, Item:=1
            If con > 0 Then
                For lo2 = con To 1 Step -1
                    dic(loo - lo2) = dic(loo - lo2) + 1
                Next lo2
            End If
            con = con + 1
        Else
            dic.Add key:=loo, Item:=0
            con = 0
        End If
    Next loo
  
    Dim key As Variant
    For Each key In dic.Keys
    '    Debug.Print key, ":", dic(key)
        Cells(key, 2) = dic(key)
    Next key
  
End Sub

It requires the data to be in column A and the output to column B, but could be easily adjusted. It also presumes the active sheet is the input.

The logic could be better - e.g. working backwards up column A would actually be easier, but I was done before I thought about doing that.

Thank you that worked perfectly.

 

[Peter_SSs]

You said a formula would do so you could try this fairly short one, copied down.

20 05 24.xlsm
	A	B
1	Original Data	Consecutive negative numbers
2	1	0
3	-2	1
4	0	0
5	-1	3
6	-1	2
7	-2	1
8	3	0
9	2	0
Count

Cell Formulas
Range	Formula
B2:B9	B2	=(B3+1)*(A2<0)

 

[Peter_SSs]

The above could be adapted to a macro if you prefer that method

Sub CountNegatives()
  With Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    .FormulaR1C1 = "=(R[1]C+1)*(RC[-1]<0)"
    .Value = .Value
  End With
End Sub