469,348 Members | 1,303 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,348 developers. It's quick & easy.

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 4861
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
  9. ' load and sort
  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
  9. ' load and sort
  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.
Dec 19 '10 #9

Post your reply

Sign in to post your reply or Sign up for a free account.

By using this site, you agree to our Privacy Policy and Terms of Use.