472,096 Members | 1,258 Online

# How to count consecutive numbers in a string of numbers

Can anyone help me with a Formula in VB/excel to COUNT how many numbers are consecutive
within a Row that spans 20 Columns?

Example:
65 67 68 69 75 79 80 84 85 90 78 73 61 93 92 91 95 6 33 99

The answer to the above example should be a Count of 11.
In order to illustrate what I mean to say that I require a total count of the
individual numbers that make up the consecutive. In the example above, we do the counting in this way: So, rather than 67/68 = 1
or 79/80 = 1.

I need 90 93, 92, 91 = 4
67,68,69 = 3
79,80 = 2
84,85 = 2
---
Total Count = 11
Is there a way that a Formula can be put together to count the above and to get the correct answer.
I'd like to this for an extremely large number list for each line, individually, in a spreadsheet like excel.

Regards, Tasmanian Devil
Oct 24 '10 #1
8 5121
Is there someone in this forum that would like to share knowledge in helping to solve this puzzle?

I'm looking forward to receiving good news.
Nov 21 '10 #2
Guido Geurs
767 Expert 512MB
How :
- put the data in an array
- sort line by line
- find consecutive numbers
- dump data in sheet
This is the code for creating and sorting the array:

Expand|Select|Wrap|Line Numbers
1. Public Sub Count()
2. Dim ARRdata() As Variant
3. Dim ARRdataROWidx As Integer
4. Dim ARRdataCOLidx As Integer
5. Dim ARRtemp(1 To 20) As Integer
6.    Sheets("data").Select
7.    ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
8.    For ARRdataROWidx = LBound(ARRdata, 1) To UBound(ARRdata, 1)
9.       For ARRdataCOLidx = 1 To 20
10.          ARRtemp(ARRdataCOLidx) = ARRdata(ARRdataROWidx, ARRdataCOLidx)
11.       Next
12.       Call Sort_Array(ARRtemp)
13.       For ARRdataCOLidx = 1 To 20
14.          ARRdata(ARRdataROWidx, ARRdataCOLidx) = ARRtemp(ARRdataCOLidx)
15.       Next
16.    Next
17. ...
18. 'count consecutive numbers
19. ...
20. 'dump to ...
21. ...
22. End Sub
23.
24. Public Function Sort_Array(ByRef THEarray As Variant)
25. Dim TEMP As Variant
26. Dim X As Integer
27. Dim SORTED As Boolean
28.    SORTED = False
29.    Do While Not SORTED
30.       SORTED = True
31.       For X = 1 To UBound(THEarray) - 1
32.          If THEarray(X) > THEarray(X + 1) Then
33.             TEMP = THEarray(X + 1)
34.             THEarray(X + 1) = THEarray(X)
35.             THEarray(X) = TEMP
36.             SORTED = False
37.          End If
38.       Next X
39.    Loop
40. End Function
Nov 21 '10 #3
many thanks for your help but your formula displays an error message: it isn't possible for Visual Basic to determine which action to be performed.
And it says that the possible causes are: there is syntax error: punctuation or the data inputed are wrong and it isn't work out.
In vb the script stops:
an yellow arrow points here: Public Sub Count()

and only these 3 points [...] are marked in red

Next
Next
...
'count consecutive numbers
...
'dump to ...
...
End Sub
Nov 22 '10 #4
Guido Geurs
767 Expert 512MB
This is normal because it's the place where the code for the calculation must be placed.

In Your call You are giving the example and say it must be 11 ??? not 12 ???

65 67 68 69 75 79 80 84 85 90 78 73 61 93 92 91 95 6 33 99
67 68 69 79 80 84 85 90 78 93 92 91 = 12 !

the code for calculating =

Expand|Select|Wrap|Line Numbers
1. Public Sub COUNT()
2. Dim ARRdata() As Variant
3. Dim ARRdataROW As Integer
4. Dim ARRdataCOL As Integer
5. Dim ARRtemp(1 To 20) As Integer
6. Dim FIRST As Boolean
7. Dim COUNT As Integer
8. Dim ARRresults() As Integer
10.    Sheets("data").Select
11.    ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
12.    ReDim ARRresults(LBound(ARRdata, 1) To UBound(ARRdata, 1))
13.    For ARRdataROW = LBound(ARRdata, 1) To UBound(ARRdata, 1)
14.       For ARRdataCOL = 1 To 20
15.          ARRtemp(ARRdataCOL) = ARRdata(ARRdataROW, ARRdataCOL)
16.       Next
17.       Call Sort_Array(ARRtemp)
18.       For ARRdataCOL = 1 To 20
19.          ARRdata(ARRdataROW, ARRdataCOL) = ARRtemp(ARRdataCOL)
20.       Next
21. '§ count
22.       FIRST = True
23.       COUNT = 0
24.       For ARRdataCOL = 1 To 19
25.          If ARRdata(ARRdataROW, ARRdataCOL) + 1 = ARRdata(ARRdataROW, ARRdataCOL + 1) Then
26.             If FIRST Then
27.                COUNT = COUNT + 2
28.             Else
29.                COUNT = COUNT + 1
30.             End If
31.             FIRST = False
32.          Else
33.             FIRST = True
34.          End If
35.       Next
36.       ARRresults(ARRdataROW) = COUNT
37.    Next
38. '§ dump
39.    Range("A20").Resize(UBound(ARRdata, 1), 20) = ARRdata
40.    Range("V20").Resize(UBound(ARRresults), 1) = ARRresults
41. End Sub
I have dumped the results in A20... and V20...
If You want to see the results elsewhere, please change the code.
Nov 22 '10 #5
Guido Geurs
767 Expert 512MB
Sorry, there is an error in the code for ARRresults.

Expand|Select|Wrap|Line Numbers
1. Public Sub COUNT()
2. Dim ARRdata() As Variant
3. Dim ARRdataROW As Integer
4. Dim ARRdataCOL As Integer
5. Dim ARRtemp(1 To 20) As Integer
6. Dim FIRST As Boolean
7. Dim COUNT As Integer
8. Dim ARRresults() As Integer
10.    Sheets("data").Select
11.    ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
12.    ReDim ARRresults(LBound(ARRdata, 1) To UBound(ARRdata, 1), 1 To 1)
13.    For ARRdataROW = LBound(ARRdata, 1) To UBound(ARRdata, 1)
14.       For ARRdataCOL = 1 To 20
15.          ARRtemp(ARRdataCOL) = ARRdata(ARRdataROW, ARRdataCOL)
16.       Next
17.       Call Sort_Array(ARRtemp)
18.       For ARRdataCOL = 1 To 20
19.          ARRdata(ARRdataROW, ARRdataCOL) = ARRtemp(ARRdataCOL)
20.       Next
21. '§ count
22.       FIRST = True
23.       COUNT = 0
24.       For ARRdataCOL = 1 To 19
25.          If ARRdata(ARRdataROW, ARRdataCOL) + 1 = ARRdata(ARRdataROW, ARRdataCOL + 1) Then
26.             If FIRST Then
27.                COUNT = COUNT + 2
28.             Else
29.                COUNT = COUNT + 1
30.             End If
31.             FIRST = False
32.          Else
33.             FIRST = True
34.          End If
35.       Next
36.       ARRresults(ARRdataROW, 1) = COUNT
37.    Next
38. '§ dump
39.    Range("A20").Resize(UBound(ARRdata, 1), 20) = ARRdata
40.    Range("V20").Resize(UBound(ARRresults), 1) = ARRresults
41. End Sub
Nov 22 '10 #6
smartchap
236 100+
I think best way is to copy whole row in a new empty row or better in a new sheet at first row. arrange it in ascending order (by formula), now check each column one by one from first column in first row if its value is 1 more than previous, then increment the counter. Thats the result. For other rows of data do same thing.
Nov 23 '10 #7
the last code that you provided isn't working. In vba some lines are appearing in red:
Dim*ARRdata()*As*Variant
Dim*ARRtemp(1*To*20)*As*Integer
Dim*ARRresults()*As*Integer
ReDim*ARRresults(LBound(ARRdata,*1)*To*UBound(ARRd ata,*1),*1*To*1)
***For*ARRdataROW*=*LBound(ARRdata,*1)*To*UBound(A RRdata,*1)

*ARRtemp(ARRdataCOL)*=*ARRdata(ARRdataROW,*ARRdata COL)
**************ARRdata(ARRdataROW,*ARRdataCOL)*=*AR Rtemp(ARRdataCOL)

If*ARRdata(ARRdataROW,*ARRdataCOL)*+*1*=*ARRdata(A RRdataROW,*ARRdataCOL*+*1)*Then
************If*FIRST*Then
ARRresults(ARRdataROW,*1)*=*COUNT
***
***Range("A20").Resize(UBound(ARRdata,*1),*20)*=*A RRdata
***Range("V20").Resize(UBound(ARRresults),*1)*=*AR Rresults

and excel isn't reconignizing that
there's a macro of this code.

merci beaucoup en avance
Dec 18 '10 #8
Guido Geurs
767 Expert 512MB
I'm using Excel 2003 and the macro runs without a problem.
(see attachment)
If Your using an other version maybe You have to translate this code to the new version.
Attached Files
 How to count consecutive numbers in a string of numbers_v1.4.zip (9.4 KB, 145 views)
Dec 19 '10 #9