Search code examples
vbaexcelrangeoffset

Count number of unbroken 'strings' of numbers across a row in VBA Function


I have been battling this one for days, and am clearly missing something. It has been a while since I last used VBA and I am struggling to remember.

Looking to find the number of 'tours' or uninterupted 'strings' of 1's across a row.

Data and answer I am looking for is this (with each number being in its own column):

0 0 1 1 1 0 1 0 1 = 3
1 0 0 0 0 0 0 0 0 = 1
0 0 0 0 1 1 1 1 1 = 1

Have tried the following Functions:

Function TOURCOUNT(TourList As Range)
Dim var As Variant

var = TourList.Value

For Each var In TourList
    If var = 1 And var + 1 = 1 Then
    TOURCOUNT = TOURCOUNT
    ElseIf var = 1 Then
    TOURCOUNT = TOURCOUNT + 1
    End If
Next

End Function

And just running through the cells:

Function NTOURS(TList As Range)

Dim var As Variant

For Each Cell In TList
    If Cell.Offset(0, 1).Value = 1 And Cell.Value = 1 Then
        NTOURS = NTOURS + 1
    End If
Next
End Function

And a few other minor variations. Clearly I am not understanind something correctly. The 'And' evaluate Offset if statement returned the wrong numbers when I accidently offset rows instead of columns. But when I correct that it just returns 0.

Any help would be greatly appreciated!!

Thank you!


Solution

  • I am not sure what you are trying to do, but judging from your examples, something like this would do the work.

    In general, you pass the range as a parameter, it goes in the row and it makes two checks pro case in the loop. If both checks are successful, lngResult is incremented.

    enter image description here

    Option Explicit
    
    Public Function Uninterrupted(rngRange As Range) As Long
    
        Dim rngCell         As Range
        Dim lngResult       As Long
        Dim blnInterruped   As Boolean
    
        For Each rngCell In rngRange
            If rngCell Then
                If Not blnInterruped Then lngResult = lngResult + 1
                blnInterruped = True
            Else
                blnInterruped = False
            End If
        Next rngCell
    
        Uninterrupted = lngResult
    
    End Function