How to count consecutive numbers in a string of numbers

[TasmanianDevil]

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

[TasmanianDevil]

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.

[Guido Geurs]

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:

Public Sub Count()
Dim ARRdata() As Variant
Dim ARRdataROWidx As Integer
Dim ARRdataCOLidx As Integer
Dim ARRtemp(1 To 20) As Integer
   Sheets("data").Select
   ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
   For ARRdataROWidx = LBound(ARRdata, 1) To UBound(ARRdata, 1)
      For ARRdataCOLidx = 1 To 20
         ARRtemp(ARRdataCOLidx) = ARRdata(ARRdataROWidx, ARRdataCOLidx)
      Next
      Call Sort_Array(ARRtemp)
      For ARRdataCOLidx = 1 To 20
         ARRdata(ARRdataROWidx, ARRdataCOLidx) = ARRtemp(ARRdataCOLidx)
      Next
   Next
...
'count consecutive numbers
...
'dump to ...
...
End Sub

Public Function Sort_Array(ByRef THEarray As Variant)
Dim TEMP As Variant
Dim X As Integer
Dim SORTED As Boolean
   SORTED = False
   Do While Not SORTED
      SORTED = True
      For X = 1 To UBound(THEarray) - 1
         If THEarray(X) > THEarray(X + 1) Then
            TEMP = THEarray(X + 1)
            THEarray(X + 1) = THEarray(X)
            THEarray(X) = TEMP
            SORTED = False
         End If
      Next X
   Loop
End Function

[TasmanianDevil]

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

[Guido Geurs]

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 =

Public Sub COUNT()
Dim ARRdata() As Variant
Dim ARRdataROW As Integer
Dim ARRdataCOL As Integer
Dim ARRtemp(1 To 20) As Integer
Dim FIRST As Boolean
Dim COUNT As Integer
Dim ARRresults() As Integer
'§ load and sort
   Sheets("data").Select
   ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
   ReDim ARRresults(LBound(ARRdata, 1) To UBound(ARRdata, 1))
   For ARRdataROW = LBound(ARRdata, 1) To UBound(ARRdata, 1)
      For ARRdataCOL = 1 To 20
         ARRtemp(ARRdataCOL) = ARRdata(ARRdataROW, ARRdataCOL)
      Next
      Call Sort_Array(ARRtemp)
      For ARRdataCOL = 1 To 20
         ARRdata(ARRdataROW, ARRdataCOL) = ARRtemp(ARRdataCOL)
      Next
'§ count
      FIRST = True
      COUNT = 0
      For ARRdataCOL = 1 To 19
         If ARRdata(ARRdataROW, ARRdataCOL) + 1 = ARRdata(ARRdataROW, ARRdataCOL + 1) Then
            If FIRST Then
               COUNT = COUNT + 2
            Else
               COUNT = COUNT + 1
            End If
            FIRST = False
         Else
            FIRST = True
         End If
      Next
      ARRresults(ARRdataROW) = COUNT
   Next
'§ dump
   Range("A20").Resize(UBound(ARRdata, 1), 20) = ARRdata
   Range("V20").Resize(UBound(ARRresults), 1) = ARRresults
End Sub

I have dumped the results in A20... and V20...
If You want to see the results elsewhere, please change the code.

[Guido Geurs]

Sorry, there is an error in the code for ARRresults.

Public Sub COUNT()
Dim ARRdata() As Variant
Dim ARRdataROW As Integer
Dim ARRdataCOL As Integer
Dim ARRtemp(1 To 20) As Integer
Dim FIRST As Boolean
Dim COUNT As Integer
Dim ARRresults() As Integer
'§ load and sort
   Sheets("data").Select
   ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
   ReDim ARRresults(LBound(ARRdata, 1) To UBound(ARRdata, 1), 1 To 1)
   For ARRdataROW = LBound(ARRdata, 1) To UBound(ARRdata, 1)
      For ARRdataCOL = 1 To 20
         ARRtemp(ARRdataCOL) = ARRdata(ARRdataROW, ARRdataCOL)
      Next
      Call Sort_Array(ARRtemp)
      For ARRdataCOL = 1 To 20
         ARRdata(ARRdataROW, ARRdataCOL) = ARRtemp(ARRdataCOL)
      Next
'§ count
      FIRST = True
      COUNT = 0
      For ARRdataCOL = 1 To 19
         If ARRdata(ARRdataROW, ARRdataCOL) + 1 = ARRdata(ARRdataROW, ARRdataCOL + 1) Then
            If FIRST Then
               COUNT = COUNT + 2
            Else
               COUNT = COUNT + 1
            End If
            FIRST = False
         Else
            FIRST = True
         End If
      Next
      ARRresults(ARRdataROW, 1) = COUNT
   Next
'§ dump
   Range("A20").Resize(UBound(ARRdata, 1), 20) = ARRdata
   Range("V20").Resize(UBound(ARRresults), 1) = ARRresults
End Sub

[smartchap]

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.

[TasmanianDevil]

the last code that you provided isn't working. In vba some lines are appearing in red:
Dim*ARRdata()*A s*Variant
Dim*ARRtemp(1*T o*20)*As*Intege r
Dim*ARRresults( )*As*Integer
ReDim*ARRresult s(LBound(ARRdat a,*1)*To*UBound (ARRdata,*1),*1 *To*1)
***For*ARRdataR OW*=*LBound(ARR data,*1)*To*UBo und(ARRdata,*1)

*ARRtemp(ARRdat aCOL)*=*ARRdata (ARRdataROW,*AR RdataCOL)
**************A RRdata(ARRdataR OW,*ARRdataCOL) *=*ARRtemp(ARRd ataCOL)

If*ARRdata(ARRd ataROW,*ARRdata COL)*+*1*=*ARRd ata(ARRdataROW, *ARRdataCOL*+*1 )*Then
************If* FIRST*Then
ARRresults(ARRd ataROW,*1)*=*CO UNT
***
***Range("A20") .Resize(UBound( ARRdata,*1),*20 )*=*ARRdata
***Range("V20") .Resize(UBound( ARRresults),*1) *=*ARRresults

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

merci beaucoup en avance

[Guido Geurs]

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.