Summary Report: Modifying Solution

Question

This is a follow up to a question found here.

The solution provided by Grade 'Eh' Bacon assumed that each decimal code corresponded to a specific status, however that is not the case. The decimal code must first be converted to binary and each bit corresponds to a specific description. So, for example, 0000000000000001 would correspond to just one status "Idle Cutout Active", and 0000000001000001 would correspond to two statuses "High Coolant Temperature" and "Idle Cutout Active".

I've devised a way to split the 16-bit string into each bit and populate a series of columns such that my data looks like this:

Note: The data continues well beyond the row that can be seen in the image above; it goes until Row 8651.

Is there a way that this solution could be modified to count the 1s columns D through S rather than look at the decimal code in Column B?. I imagine this would result in a great number of columns being used, so perhaps there's a more optimal way to do what I'm trying to get done. To reiterate, what I want to do is find the Start and End time of five or more consecutive 1s with timestamps that are within 2 minutes of eachtoher, and have the corresponding descriptor appear with that Start and End time stamp so that I can achieve a more readable format for the data that appears above. It'd look something like:

So, is there a way to modify the current solution or should I consider an entirely new solution? If the later, what would you recommend?

To Experiment:

I've put together a sample Workbook with Grade 'Eh' Bacon's solution implemented and an example of the data that I'm working with. The workbook can be downloaded from here.

Thank you,

Dan

EDIT 1:

I've altered the code Tim Williams posted to suit my needs, and also added some functionality to make it better for what I'm doing. The file on Google Drive has the updated code in full, but to summarize I made some slight alterations to Tim's code so that it fit the data I had and then wrote two additional subs. The first is to replace all the various "Flag#:XX" values that appear when the code is run with the engine status descriptors, and the other is to sort the values by their start time stamps. Here's what his code looks like with the alterations that I made:

Public Type flag
        tStart As Variant  'flag start time
        tLast As Variant   'last event time
        Count As Long      'number of 1's
End Type
Sub Report()
'Type to track data for each of the bit positions (event types)

    Dim flags() As flag
    Dim c As Range, nF As Long, i As Long, v, f, t
    Dim shtReport As Worksheet, bContinue As Boolean

    Set shtReport = ThisWorkbook.Sheets("Technician Report Summary")
    Set c = Sheets("RAW DATA").Range("C2")
    nF = Len(c.Value)
    ReDim flags(1 To nF)
    bContinue = True

    Do
        v = c.Value               'bitstring
        t = c.Offset(0, -2).Value 'timestamp

        If Len(v) = 0 Then
            'No more data, so insert a "dummy" value to trigger
            ' writing out any current "events"
            v = String(nF, "0")
            bContinue = False
        End If

        'loop over each "bit" in the string
        For i = 1 To nF
            f = Mid(v, i, 1)
            If f = "1" Then
                'first instance of this flag ?
                If flags(i).Count = 0 Then
                    flags(i).tStart = t 'event begins - set start time
                Else
                    flags(i).tLast = t 'event continues - set "last" time
                End If
                flags(i).Count = flags(i).Count + 1
            End If
            If f = "0" Then
                'end of a run of 5 or more 1's ?
                If flags(i).Count >= 5 Then
                    'write event to Report sheet
                    With shtReport.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        .Value = "Flag#:" & i
                        .Offset(0, 1).Value = flags(i).tStart
                        .Offset(0, 2).Value = flags(i).tLast
                    End With
                End If
                flags(i).Count = 0
            End If
        Next i

        Set c = c.Offset(1, 0)

    Loop While bContinue
    Call Sort
    Call FindAndReplace

End Sub

I think it now does what I'm looking for. I'll verify further, but as it stands I think I've found a solution that works.

Answer 1

You could try something like this:

'Type to track data for each of the bit positions (event types)
Public Type flag
    tStart As Variant  'flag start time
    tLast As Variant   'last event time
    Count As Long      'number of 1's
End Type

Sub Report()

    Dim flags() As flag
    Dim c As Range, nF As Long, i As Long, v, f, t
    Dim shtReport As Worksheet, bContinue As Boolean

    Set shtReport = ThisWorkbook.Sheets("Report")
    Set c = Sheet1.Range("B2")
    nF = Len(c.Value)
    ReDim flags(1 To nF)
    bContinue = True

    Do
        v = c.Value               'bitstring
        t = c.Offset(0, -1).Value 'timestamp

        If Len(v) = 0 Then
            'No more data, so insert a "dummy" value to trigger
            ' writing out any current "events"
            v = String(nF, "0")
            bContinue = False
        End If

        'loop over each "bit" in the string
        For i = 1 To nF
            f = Mid(v, i, 1)
            If f = "1" Then
                'first instance of this flag ?
                If flags(i).Count = 0 Then
                    flags(i).tStart = t 'event begins - set start time
                Else
                    flags(i).tLast = t 'event continues - set "last" time
                End If
                flags(i).Count = flags(i).Count + 1
            End If
            If f = "0" Then
                'end of a run of 5 or more 1's ?
                If flags(i).Count >= 5 Then
                    'write event to Report sheet
                    With shtReport.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        .Value = "Flag#:" & i
                        .Offset(0, 1).Value = flags(i).tStart
                        .Offset(0, 2).Value = flags(i).tLast
                    End With
                End If
                flags(i).Count = 0
            End If
        Next i

        Set c = c.Offset(1, 0)

    Loop While bContinue

End Sub

EDIT: fixed up a couple of typos and accounted for what happens at the end of the data if there are events "ongoing"