Count Values in sequence

JonRowland · Apr 22, 2024

This is what I would like to do using VBA. Any help to get me started would be great.

In Col T there is a variable range of different values. The values can change throughout the range and I would like to loop through the range and recorded the first and last time the values in T appear in their seqeunce and to count how many times in the sequence the values appear. Date/Time are in Col A & B accordingly. If there is "-" in T then this should be ignored?

Here is an example

Col A Col B Col T
01/01/1999 19:19:32 999123
01/01/1999 19:21:56 999123
01/01/1999 19:22:08 77777
01/01/1999 19:22:10 77777
01/01/1999 19:22:24 77777
01/01/1999 19:27:13 77777
01/01/1999 19:30:38 77777
01/01/1999 19:32:04 77777
01/01/1999 19:32:59 77777
01/01/1999 19:34:06 77777
01/01/1999 19:34:31 77777
01/01/1999 19:35:27 999123
01/01/1999 19:36:05 999123
01/01/1999 19:36:45 999123
01/01/1999 19:37:42 999123
01/01/1999 19:38:47 999123
01/01/1999 19:41:01 999123
01/01/1999 19:43:57 999123

Output result to new worksheet as something like

ColT Vlu Count First Appears Last Appears
999123 2 19:19:32 01/01/1999 19:21:56 01/01/1999
7777 9 19:22:08 01/01/1999 19:34:31 01/01/1999
999123 7 19:35:27 01/01/1999 19:43:57 01/01/1999

myall_blues · Apr 23, 2024

Perhaps something like this to get you started? I've assumed the input data is sorted by date and time.

VBA Code:

Option Explicit
Sub test()
    Dim coll As New Collection
    Dim lastRow As Long, i As Long, count As Long, collRow As Long, outRow As Long
    Dim tVal As Variant, aValmin As Variant, aValmax As Variant
    Dim bValmin As Variant, bValmax As Variant
    '
    ' Get last data row
    '
    lastRow = Worksheets("Sheet1").Cells.Find("*", _
                                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    '
    ' Set initial data values
    '
    outRow = 2
    aValmin = Cells(2, 1).Value
    aValmax = aValmin
    bValmin = Cells(2, 2).Value
    bValmax = bValmin
    tVal = Cells(2, 20).Value
    count = 1
    '
    ' For each row, update maximum value of T value is the same, or
    ' write out last values to collection
    '
    For i = 3 To lastRow
        If Cells(i, 20).Value = tVal Then
            aValmax = Cells(i, 1).Value
            bValmax = Cells(i, 2).Value
            count = count + 1
        Else
            coll.Add tVal
            coll.Add count
            coll.Add aValmin
            coll.Add bValmin
            coll.Add aValmax
            coll.Add bValmax
            '
            ' Reset the data values
            '
            aValmin = Cells(i, 1).Value
            aValmax = aValmin
            bValmin = Cells(i, 2).Value
            bValmax = bValmin
            tVal = Cells(i, 20).Value
            count = 1
        End If
    Next i
            '
            ' Write the last value to the collection
            '
            coll.Add tVal
            coll.Add count
            coll.Add aValmin
            coll.Add bValmin
            coll.Add aValmax
            coll.Add bValmax
    '
    ' Write out the collection
    '
    For collRow = 1 To coll.count Step 6
        ActiveSheet.Cells(outRow, 22) = coll(collRow)
        ActiveSheet.Cells(outRow, 23) = coll(collRow + 1)
        ActiveSheet.Cells(outRow, 24) = coll(collRow + 2)
        ActiveSheet.Cells(outRow, 25) = Format(coll(collRow + 3), "hh:mm:ss")
        ActiveSheet.Cells(outRow, 26) = coll(collRow + 4)
        ActiveSheet.Cells(outRow, 27) = Format(coll(collRow + 5), "hh:mm:ss")
        outRow = outRow + 1
    Next collRow
End Sub

Produces the following output from your test data:

Book1

A

B

C

T

U

V

W

X

Y

Z

AA

1

2

1/01/1999

19:19:32

999123

2

1/01/1999

19:19:32

1/01/1999

19:21:56

3

1/01/1999

19:21:56

999123

77777

9

1/01/1999

19:22:08

1/01/1999

19:34:31

4

1/01/1999

19:22:08

77777

999123

7

1/01/1999

19:35:27

1/01/1999