Count consecutive values down a column

Giganews Newsgroups
Subject: Count consecutive values down a column
Posted by:  Jon Macmichael (jonm…@bigpond.com)
Date: 29 May 2004

I have many tick records from live market data, in many separate files
(one for each stock symbol).

I am trying to make a new file of 2 fields; date & a count of the
number of ticks (or records in the original file) for each date. The
records in the original files show records (ticks) for any one date as
ranging from 1 to well over 1000. The VB I've attempted to write has
struck maybe it's biggest error where there is only one recortd
(tick).

Otherwise I've managed to account for importing the original text via
macro and exporting the same (with thanks to Chip Pearson), ans also
account for my date format of "yymmdd" which was difficult for periods
of say 23rdJan2000, but format-custom-' 000000 ' seems to have
overcome that(also thanks to this site).

To begin I must say I thought I had this all working via Pivot Tables
which failed  where I have many records (in some cases I'll have to
split the original files to pass the 65000 record limit. Pivot Tables
seem to get stuck under 10000 somewhere.

So far my 'method' has been to copy the date column A:A to K:K for
formating. Then I've run an Advance Filter for 'Unique records only'
of K:K to M:M (now, aside from the column header "DATE", M:M holds the
final date column data that I require. Now I only need a count of each
date in M:M from K:K and put in N:N,  (K:K holds many duplicates of
each of M:M).

I have tested a simply function here ie: =CountIF(K:K,M2)  ... ,M3)
and so on. However, I figure that won't work as fast as the following
macro might, which is the first big one for me - a battle when I
really don't know what I'm doing and have been at it for many hours.

Two errors that have arisen are;
1# The values corrupt where there is only one tick for one date.
2# the code stops when the selected cell is N716 (this could relate to
cell K5523 or K5538) and gives the message; "Runtime error '6'
Overflow" and there's a yellow debugging line where I've marked '
OVERFLOW in the code below.

Im using Excel97.

Here's a sample of K:K with the macro below.
"DATE"
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990812
990813
990813
990813
990813
990813
990813
990813
990813
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990816
990817
990817
990817
990817
990817
990817
990817
990817
990817
990818
990818
990818
990818
990818
990818
990818
990818
990818
990818
990819
990819
990819
990819
990820
990820
990820
990820
990820
990820
990820
990820
990820
990820
990820
990823
990824
990824
990825
990826
990827
990827
990830
990830
990830
990831
990901
990902
990902
990902
990903
990903
990903
990903
990906
990906
990908
990909
990909
990909
990909
990909
990909
990909
990909
990909

Sub TickCnt()
'
Dim S1 As Worksheet
Dim here As Range
Dim rTop As Range
Dim Cnt1 As Integer
Dim ticks As Integer
Dim IntRow As Long
Dim HereNow As Range

Set S1 = Worksheets("Open in this sheet")
Set here = S1.Range("N2")
here.Select
Set rTop = ActiveCell.Offset(0, -3)
Set rBot = ActiveCell.Offset(1, -3)
ticks = 1
Cnt1 = 1
IntRow = 0
IntTooMany = 0

If rTop <> "" Then
    Do
    If ActiveCell = Cells(2, 14) Then
        ticks = 1
    Else
        ticks = 2
    End If
        Do
            If rBot <> rTop Then Exit Do
            ticks = ticks + 1
            Cnt1 = Cnt1 + 1
            rBot = ActiveCell.Offset(IntRow + Cnt1 + IntooMany, -3)
        Loop

        here.Value = ticks
        Set rTop = ActiveCell.Offset(IntRow + Cnt1 + IntooMany, -3)
        IntRow = IntRow + Cnt1
        Set here = ActiveCell.Offset(1, 0)
        here.Select

        ' check for a "single" tick
        If ActiveCell.Offset(IntRow + IntTooMany, -3) <> rTop Then
            here.Value = 1
            Set rTop = ActiveCell.Offset(IntRow + IntTooMany, -3)
            Set rBot = ActiveCell.Offset(IntRow + IntTooMany + 1, -3)
            'IntRow = IntRow + 1
            'Set here = ActiveCell.Offset(1, 0)
            'here.Select
            IntTooMany = IntTooMant - 1
            Else

            Set rBot = ActiveCell.Offset(IntRow + IntTooMany, -3)
            IntTooMany = IntTooMant - 1

        End If

        Cnt1 = 1                                    ' was above
IntTooMany
    Loop
End If
End Sub

Replies