Count every group of numbers whose sum is zero & put number next toeach number

[al]

I have the following numbers in column A
1
2
3
-2
-4
5
5
-10
3
3
-6

I need in column B next to each number - the number telling me to
which
group of sum zero it belows(by selecting first cell next to column A
up to last cell - (B1:B11) i.e

1,2,3,-2,-4 would each have number 1 next to each of them in column B
(first group of sum zero)

5,5,-10 would each have number 2 next each of them in column B (second
group of sum zero)

3,3,-6 would each have number 3 next to each of them in column B
(third group of sun zero)


Need a macro which would work in any range of numbers in any column
( not necessarily column A i.e if numbers are in column D - count
would be in column E next to the number

Pls help thxs

 

[Tim Zych]

Here is one way. I made certain assumptions:

1. The numbers will always be contiguous by group. Each series of numbers
which must sum to zero are together from the start.

2. What happens if there are numbers which, pursuant to rule #1, do not
evemtially sum to zero? Omit them and keep processing for the duration.


Sub GroupSumZeroes()
Dim rng As Range, n As Long, ttl As Double, nIndex As Long
Dim cell1 As Range, cell2 As Range
Set rng = Range(Range("A1"), Range("A1").End(xlDown)) ' Adjust as needed
rng.Offset(, 1).ClearContents
nIndex = 1
Set cell1 = rng(1)
For n = 1 To rng.Cells.Count
ttl = ttl + rng(n).Value
If ttl = 0 Then
Set cell2 = rng(n)
Range(cell1, cell2).Offset(, 1).Value = nIndex
Set cell1 = cell2(2)
nIndex = nIndex + 1
End If
Next
End Sub

 

[al]

Here is one way. I made certain assumptions:

1. The numbers will always be contiguous by group. Each series of numbers
which must sum to zero are together from the start.

2. What happens if there are numbers which, pursuant to rule #1, do not
evemtially sum to zero? Omit them and keep processing for the duration.

Sub GroupSumZeroes()
Dim rng As Range, n As Long, ttl As Double, nIndex As Long
Dim cell1 As Range, cell2 As Range
Set rng = Range(Range("A1"), Range("A1").End(xlDown)) ' Adjust as needed
rng.Offset(, 1).ClearContents
nIndex = 1
Set cell1 = rng(1)
For n = 1 To rng.Cells.Count
ttl = ttl + rng(n).Value
If ttl = 0 Then
Set cell2 = rng(n)
Range(cell1, cell2).Offset(, 1).Value = nIndex
Set cell1 = cell2(2)
nIndex = nIndex + 1
End If
Next
End Sub

thxs tim - the macro works great - have adjusted it so that it can
work on all ranges other than starting A1 as per below - can you pls
modify the macro so as to add the letters "JE" before the resulting
count numbers e.g JE1, JE2, JE3, ....
thxs beforehand - what do you think of using an input message box
where the user can change JE to anything else later.
THXS THXS

 

[Tim Zych]

Sub GroupSumZeroes()
Dim rng As Range, n As Long, ttl As Double, nIndex As Long
Dim cell1 As Range, cell2 As Range
Dim Prefix As String
Prefix = InputBox("Enter Prefix", , "JE")
If Prefix = "" Then Exit Sub
Set rng = Range(Range("A1"), Range("A1").End(xlDown)) ' Adjust as needed
rng.Offset(, 1).ClearContents
nIndex = 1
Set cell1 = rng(1)
For n = 1 To rng.Cells.Count
ttl = ttl + rng(n).Value
If ttl = 0 Then
Set cell2 = rng(n)
Range(cell1, cell2).Offset(, 1).Value = Prefix & nIndex
Set cell1 = cell2(2)
nIndex = nIndex + 1
End If
Next
End Sub

 

[al]

Sub GroupSumZeroes()
Dim rng As Range, n As Long, ttl As Double, nIndex As Long
Dim cell1 As Range, cell2 As Range
Dim Prefix As String
Prefix = InputBox("Enter Prefix", , "JE")
If Prefix = "" Then Exit Sub
Set rng = Range(Range("A1"), Range("A1").End(xlDown)) ' Adjust as needed
rng.Offset(, 1).ClearContents
nIndex = 1
Set cell1 = rng(1)
For n = 1 To rng.Cells.Count
ttl = ttl + rng(n).Value
If ttl = 0 Then
Set cell2 = rng(n)
Range(cell1, cell2).Offset(, 1).Value = Prefix & nIndex
Set cell1 = cell2(2)
nIndex = nIndex + 1
End If
Next
End Sub

thxs thxs
i tried to add code below after your macro but it does not work - thxs
for your help!!!
Selection.Value = "JE" & Selection.Value

 

[al]

Sub GroupSumZeroes()
Dim rng As Range, n As Long, ttl As Double, nIndex As Long
Dim cell1 As Range, cell2 As Range
Dim Prefix As String
Prefix = InputBox("Enter Prefix", , "JE")
If Prefix = "" Then Exit Sub
Set rng = Range(Range("A1"), Range("A1").End(xlDown)) ' Adjust as needed
rng.Offset(, 1).ClearContents
nIndex = 1
Set cell1 = rng(1)
For n = 1 To rng.Cells.Count
ttl = ttl + rng(n).Value
If ttl = 0 Then
Set cell2 = rng(n)
Range(cell1, cell2).Offset(, 1).Value = Prefix & nIndex
Set cell1 = cell2(2)
nIndex = nIndex + 1
End If
Next
End Sub

hi tim - need a last favor from you - if i don't want my series of
numbers to start with 1 i.e 1, 2, 3 but say starting with 12, 13, 14 -
how can i add an input box message for the stating number (would be
great to leave the default number as 1 but subject to change in the
input box) thxs

 

[Chip Pearson]

Here's a simple sub that will do it.

Sub AAA()
Dim R As Range
Dim T As Long
Dim N As Long
Dim C As Long
Set R = Range("A1")
Do Until R.Value = vbNullString
T = T + R.Value
N = N + 1
If T = 0 Then
C = C + 1
R(1, 2).Offset(-1 * N + 1).Resize(N).Value = C
N = 0
End If
Set R = R(2, 1)
Loop
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)