Count consecutive negative numbers

Godwin117

New Member
Joined
Dec 19, 2019
Messages
42
Office Version
365, 2019
Platform
Windows
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 DataConsecutive negative numbers
10
-21
00
-13
-12
-21
30
20
 

Some videos you may like

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

kennypete

Board Regular
Joined
Apr 19, 2008
Messages
220
Office Version
365, 2019
Platform
Windows
Hi @Godwin117, I have tested this and it works as you want it to:
VBA Code:
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

Board Regular
Joined
Apr 19, 2008
Messages
220
Office Version
365, 2019
Platform
Windows
Indeed, here's the simpler version, which you may prefer (unless you have another use for the dictionary in V1):

VBA Code:
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

New Member
Joined
Dec 19, 2019
Messages
42
Office Version
365, 2019
Platform
Windows
Hi @Godwin117, I have tested this and it works as you want it to:
VBA Code:
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,425
Office Version
365
Platform
Windows
You said a formula would do so you could try this fairly short one, copied down.

20 05 24.xlsm
AB
1Original DataConsecutive negative numbers
210
3-21
400
5-13
6-12
7-21
830
920
Count
Cell Formulas
RangeFormula
B2:B9B2=(B3+1)*(A2<0)
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,425
Office Version
365
Platform
Windows
The above could be adapted to a macro if you prefer that method

VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,095,728
Messages
5,446,174
Members
405,389
Latest member
Excel n00b2

This Week's Hot Topics

Top