excel - count consecutive values

Hi guys. I have a great problem to solve and I can't find a solution. :(

I make an example

A B C D E F G H I J
1 2 3 6 7 8 11 12 13 14



i need to calculate how many consecutive numbers there are

OCCURRENCES
3 4 5 6 7 8 9 10 (consecutive numbers)

2 1 (count of consecutive numbers)



In this example I need to have as results 2 for 3 numbers (1,2,3 and 6,7,8) and 1 for 4 numbers (11,12,13,14)

Is there sum array formula that i can use or it occurs vba?
Thanks in advance. :)

Not sure if there is any native formula. But yes it is possible to do it in vba...

Edit

I have spent my afternoon on this so I hope you try it...

Place this in a module.

Hope this helps...

Code:

---

Option Explicit

'<---------------- Usage/Instruction--------------------->
'=FindConsecutiveStrings(Range,Number of Places to match)
'-- Example: In Cell A2 type
'=FindConsecutiveStrings(A1:R1,4)

'-- Range is the cells where the data is
'-- Number of Places to match
'  For Example 3 for 123
'  Or  4 for 6789
'  Or  5 for 12345
'<------------- End of Usage/Instruction------------------>


Function FindConsecutiveStrings(rng As Range, Numb)
    Dim cl As Range, StringFromRange As String
   
    '-- Concatenate Values
    For Each cl In rng
        StringFromRange = StringFromRange & cl.Value
    Next cl
   
    FindConsecutiveStrings = ChkConNumb(Trim(StringFromRange), Numb)
   
End Function

Function ChkConNumb(String1, NoOfPlace)
    Dim MyErrorMsg As String, Checkstring As String
    Dim Count As Integer, Check As Integer
    Dim i As Integer, j As Integer, k As Integer
   
    '-- Error Message
    MyErrorMsg = "Please enter a number which is Greater than 1 or " & _
    "a number which is Lesser than " & (Len(String1) + 1)
   
    '-- Check if the length of consecutive string is
    '  shorter than the main string
    If NoOfPlace > Len(String1) Then
        'MsgBox "Please enter a number which is Lesser than " & Len(String1)
        ChkConNumb = MyErrorMsg
        Exit Function
    End If
   
    '-- Check if the length of consecutive string is
    '  shorter than 2 Characters
    If NoOfPlace < 2 Then
        'MsgBox "Please enter a number which is Greater than 1"
        ChkConNumb = MyErrorMsg
        Exit Function
    End If
   
    Count = 0
    For i = 1 To Len(String1)
        Check = 0
        '-- This ensures that it will stop searching on
        '  reaching the relevant end of the string
        If i > Len(String1) - NoOfPlace + 1 Then Exit For
       
        Checkstring = Mid(String1, i, NoOfPlace)
       
        For j = 1 To Len(Checkstring)
            If i <> 1 Then
                '-- Checks if the starting number is not
                '  consecutive to the last batch
                If Val(Mid(Checkstring, 1, 1)) - _
                Val(Mid(String1, i - 1, 1)) <> 1 Then
                    '-- Checks if the starting number of next batch is not
                    '  consecutive to current batch
                    If Val(Mid(String1, i + Len(Checkstring), 1)) - _
                    Val(Mid(Checkstring, Len(Checkstring), 1)) <> 1 Then
                        For k = 1 To Len(Checkstring) - 1
                            '-- Final Check if the string is Consecutive
                            If Val(Mid(Checkstring, k + 1, 1)) - _
                            Val(Mid(Checkstring, k, 1)) = 1 Then
                                Check = Check + 1
                            End If
                        Next k
                       
                        If Check = NoOfPlace - 1 Then
                            Count = Count + 1
                            '-- Skip searching main string
                            i = i + NoOfPlace
                            Exit For
                        End If
                        Check = 0
                    End If
                End If
            Else
                '-- Checks if the starting number of next batch is not
                '  consecutive to current batch
                If Val(Mid(String1, i + Len(Checkstring), 1)) - _
                Val(Mid(Checkstring, Len(Checkstring), 1)) <> 1 Then
                    For k = 1 To Len(Checkstring) - 1
                        '-- Final Check if the string is Consecutive
                        If Val(Mid(Checkstring, k + 1, 1)) - _
                        Val(Mid(Checkstring, k, 1)) = 1 Then
                            Check = Check + 1
                        End If
                    Next k
                   
                    If Check = NoOfPlace - 1 Then
                        Count = Count + 1
                        '-- Skip searching main string
                        i = i + NoOfPlace
                        Exit For
                    End If
                    Check = 0
                End If
            End If
        Next j
    Next i
    '-- Store value
    ChkConNumb = Count
End Function

---

try this. it accepts a range, (limited to 1 row), counts the consecutive numbers + puts the totals in another row:

vb Code:

Sub countConsecutiveNumbers()
    Dim inputRange As Range
    Set inputRange = Range("A1:J1")
    
    Dim counter As Integer
    counter = 1
    
    For c = 2 To inputRange.Columns.Count
        If Cells(inputRange.Row, c - 1).Value = Cells(inputRange.Row, c).Value - 1 Then
           counter = counter + 1
        Else
            Cells(5, counter).Value = Cells(5, counter).Value + 1
            counter = 1
        End If
    Next
    Cells(5, counter).Value = Cells(5, counter).Value + 1
    
End Sub

Hi Paul, I have already given a code which not only accepts a range but also lets you specify "Number of Places to match" See "Usage Instructions" above...

My function:

Code:

---

Public Function CountConsec(ListRange As Range, ByVal Seq As Long) As Variant
    '-- Accept ListRange of single row or single column only
    Dim n As Long, m As Long
       
    If Seq < 1 Then CountConsec = CVErr(2015): Exit Function
    If ListRange.Areas.Count > 1 Then CountConsec = CVErr(2042): Exit Function
    n = ListRange.Rows.Count
    m = ListRange.Columns.Count
    If n > 1 And m > 1 Then CountConsec = CVErr(2042): Exit Function
    If m > 1 Then n = m
    CountConsec = 0
    If Seq <= n Then
        ReDim ar(1 To n + 1) As Long
        For m = 1 To n + 1: ar(m) = 1: Next
        For m = 2 To n
            If ListRange(m) = ListRange(m - 1) + 1 Then
                ar(m) = ar(m - 1) + 1
            End If
        Next
        For m = 1 To n
            If ar(m) = Seq And ar(m + 1) = 1 Then
                CountConsec = CountConsec + 1
            End If
        Next
    End If
End Function

---

Hi guys. I came back to post the code I've written unti now and I've found all your answers. You're very kind. Thanks to everybody for all the time you've spent to help me. I really appreciate it. Now I'll try all your solutions and I'll post a feedback. Thanks again. :)

I tried all of these codes, but they don't make the calculations exactly right.

as this thread is from 8 years ago, you should have started a new thread

what is the problem with the calculation?
is it the same problem for all the different codes?
what is the result you are getting? where is it wrong?

Quote:

---

Originally Posted by westconn1

as this thread is from 8 years ago, you should have started a new thread

what is the problem with the calculation?
is it the same problem for all the different codes?
what is the result you are getting? where is it wrong?

---

Thanks for your answer. I think It would be best to attach an example, but I couldn't attach it here, it gives invalid file type error.
So I share a link : https://1drv.ms/x/s!AoGkZUHlKui9gRPWEiSx5f68ss82

The only one that works is the third code,but the problem with it, as i see, I search for 7 consecutives in the range with 8 consecutives, it doesn't count.

I am sorry about this being an old thread, there are three ways offered here, so I wanted to ask about them.