Counting consecutive dates with VBA

[nofam]

Hi All,

I need some help with the below code. What this does is take a date range, and count the number of dates, but groups consecutive dates into 'spells', for example:

01/05/2008 1
02/05/2008 1
06/05/2008 2
09/05/2008 3
11/05/2008 4
12/05/2008 4

This would be counted as 4 'spells', which is what I want. But what I need the macro to do is to run through a list of people's names, get to the last name, offset 2 columns, and place the number of spells there:

Name:     Date:             Spells:
Charlie     01/04/2008
Charlie     02/04/2008
Charlie     03/04/2008
Charlie     06/04/2008     2

Mike        03/04/2008
Mike        04/04/2008
Mike        18/04/2008
Mike        20/04/2008
Mike        21/04/2008
Mike        29/04/2008     4​

Hope this makes sense!!

Sub spells()
    Dim i As Integer
     Range("E1").Select
    i = 1
    Do Until ActiveCell = ""
        If ActiveCell = "" Then
            GoTo 10
        Else
            ActiveCell.Offset(1, 0).Select
            If ActiveCell = ActiveCell.Offset(-1, 0) + 1 Then
                i = i
            Else
                i = i + 1
            End If
        End If
     Loop
10
    Range("H2").Select
    ActiveCell = i - 1
End Sub​

 

[LTunnicliffe]

Hellow nofam and welcome to the board.

This is a pretty interesting situation. What first came to mind was to create a UDF called spells. This can pretty easily adapted to a macro if you wish, but this is what I came up with:

Public Function Spells(DateRange As Range) As Integer

  Dim lastc
  Dim c As Range
  
  Spells = 0
  lastc = 0
  
  For Each c In DateRange
    If lastc + 1 <> c.Value Then Spells = Spells + 1
    lastc = c.Value
  Next c

End Function

HTH,

 

[facethegod]

if your data is sorted as shown in the original post.. Maybe this would work. You must modify formula ranges relative to your actual range..

=IF(COUNTIF($A$1:A4,A4)=COUNTIF($A$1:$A$10,A4),COUNTIF($A$1:$A$10,A4)-SUMPRODUCT(--($A$1:$A$10=A4),--($B$2:$B$11<>""),--($B$2:$B$11-$B$1:$B$10=1)),"")

HTH

 

[nofam]

Thanks for the contributions guys - I've since managed to get my hands on some code that works a treat as a macro, but what I'd like now is to modify the code to simply count the number of dates, and offset the results one column over from the spells:

Public Sub Spells()

    Dim rwIndex As Integer, colIndex As Integer, intCount As Integer

    'starting point in sheet (example below corresponds to B3 on sheet1)
    rwIndex = 2
    colIndex = 1
    
    'initialise spell count to 1
    intCount = 1
       
    'keep looping while there are no empty cells
    Do While IsEmpty(Worksheets("Spells").Cells(rwIndex, colIndex)) = False
                    
        If Worksheets("Spells").Cells(rwIndex, colIndex) = Worksheets("Spells").Cells(rwIndex + 1, colIndex) Then
        
            'Check to see if dates are consecutive
            If Worksheets("Spells").Cells(rwIndex, colIndex + 1) + 1 <> Worksheets("Spells").Cells(rwIndex + 1, colIndex + 1) Then
                
                'Not consecutive so add count
                intCount = intCount + 1
            
            End If
        
        Else
            
            'Output spell count
            Worksheets("Spells").Cells(rwIndex, colIndex + 2) = intCount
            
            'Reinitialise spell count to 1
            intCount = 1
        
        End If
    
        'increment row index counter
        rwIndex = rwIndex + 1
        
    Loop

End Sub

Can you suggest the best way to do this?