ThreeWave Information About Series Of Numbers

This page describes a few VBA methods for working with a series of numbers.
ShortFadeBar

Introduction

It is a common task in Excel to work with sequential series of data. This page contain a number of VBA functions that can be used to get information about a series of numbers. All the VBA code on this page requires that the data be in a single column, in sorted order, with no non-numeric or blank elements within the series. All of the examples here will assume that the range A1:A7 contains the numbers:

   1
   4
   9
   10
   11
   16
   20

You can download a bas file containing the functions shown below.

SectionBreak

Present And Missing Blocks Of Sequential Numbers

The procedure ListSeriesBlocks looks at a series of numbers in ascending sorted order and writes out to a range the present and missing blocks of data. You can specify the increment between sequential numbers. For example, given input data above, the code will write out the following, beginning in the cell referred to by Dest:

Present    1   4
Missing    5   8
Present    9   11
Missing    12  15
Present    16  16
Missing    17  19
Present    20  20

which lists the groups of numbers that are present and missing in the list. The output data always begins with a "Present" row, since it is assumed that no data is missing before the beginning of the list, alternates between "Present" and "Missing" elements, and always ends with a "Present" element, since it is assumed that no data is missing past the end of the list. 

The VBA code is shown below. Change the lines marked with <<< to your requirements.

Sub ListSeriesBlocks()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' AnalyzerSeries
' This produces a list starting in the cell specified in the
' Dest variable of the sequential blocks of numbers that are
' present or missing in a series of numbers.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim StartRow As Long     ' data begins in this row
Dim EndRow As Long       ' data ends in this row (calculated)
Dim Temp As Long
Dim RowNdx As Long
Dim Dest As Range        ' results are written starting in this cell
Dim DataColumn As String ' data is in this column
Dim WS As Worksheet      ' data resides on this worksheet
Dim SaveStart As Long
Dim DataIncrement As Long

StartRow = 1 '<<< CHANGE
DataColumn = "A" '<<< CHANGE
Set WS = Worksheets("Sheet1") '<<< CHANGE
Set Dest = Worksheets("Sheet2").Range("A1") '<<< CHANGE
DataIncrement = 1 '<<< CHANGE

With WS
    EndRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
    SaveStart = .Cells(StartRow, DataColumn)
    For RowNdx = StartRow + 1 To EndRow
        If .Cells(RowNdx, DataColumn) + DataIncrement <> _
               .Cells(RowNdx + 1, DataColumn) Then 
            Dest(1, 1) = "Present"
            Dest(1, 2) = SaveStart
            Dest(1, 3) = .Cells(RowNdx, DataColumn).Value 
            Set Dest = Dest(2, 1)
            If RowNdx <= EndRow - 1 Then
                Dest(1, 1) = "Missing" 
                Dest(1, 2) = .Cells(RowNdx, DataColumn).Value + DataIncrement
                Dest(1, 3) = .Cells(RowNdx + 1, DataColumn).Value - DataIncrement
                SaveStart = .Cells(RowNdx + 1, DataColumn).Value
            End If
            Set Dest = Dest(2, 1) 
        End If
    Next RowNdx
End With
End Sub

SectionBreak

Using A Formula To Test Elements

SeriesInfo As shown in the image to the left, the data is in the range D11:D20 and the expected increment between adjacent cells is specified in cell D10 (value of 5). The formula, entered in E11 and filled down to E20,

=IF(ROW()=ROW($E$11),"OK",IF(OFFSET(D11,-1,0,1,1)=OFFSET(D11,0,0,1,1)-$D$10,"OK",OFFSET(D11,-1,0,1,1)+$D$10&" -> "&OFFSET(D11,0,0,1,1)-$D$10))

will return a value of either "OK" if the row is the specified increment greater than the cell above it (e.g., 40 and 45 in the example), or an indication of missing element (e.g., 70 -> 80 indicating the missing numbers between the existing element 65 and 85). Note that the formula above should be entered with out any line breaks.

 

 

SectionBreak

Testing If A Series Is Sorted

The IsSeriesSorted returns True or False indicating whether the series referred to by SeriesRange is in sorted order, either ascending or descending, as specified by the Ascending parameter.

Function IsSeriesSorted(SeriesRange As Range, _
    Optional Ascending As Boolean = True) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsSeriesSorted
' This returns True or False indicating whether the values in
' SeriesRange are in sorted order, either ascending or descending,
' as specified by the Ascending parameter. SeriesRange must be a
' single column and all entries must be numeric.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim StartRow As Long
Dim EndRow As Long
Dim RowNdx As Long
Dim ColNum As Long
Dim V1 As Double
Dim V2 As Double

If SeriesRange.Columns.Count > 1 Then
    IsSeriesSorted = False
    Exit Function
End If

StartRow = SeriesRange.Cells(1, 1).Row

With SeriesRange
    EndRow = .Cells(.Cells.Count).Row
End With

ColNum = SeriesRange.Cells(1, 1).Column
With SeriesRange.Worksheet
    For RowNdx = StartRow To EndRow - 1
        If IsNumeric(.Cells(RowNdx, ColNum).Value) = False Then
            IsSeriesSorted = False 
            Exit Function
        End If
        V1 = .Cells(RowNdx, ColNum).Value
        V2 = .Cells(RowNdx + 1, ColNum).Value
        If Ascending = True Then 
            If V1 > V2 Then
                IsSeriesSorted = False
                Exit Function 
            End If
        Else 
            If V1 < V2 Then
                IsSeriesSorted = False
                Exit Function
            End If
        End If
    Next RowNdx
End With

IsSeriesSorted = True

End Function

SectionBreak

Using A Formula To Test Sorted Order

You can use a formula to test whether a series is sorted. With data in F11:F20, the following formula will test whether that data is in ascending sorted order:

=IF(SUM(IF(F12:F20-F11:F19>=0,0,1))=0,"SORTED","UNSORTED")

The following formula will test whether the same data is in descending sorted order:

=IF(SUM(IF(F12:F20-F11:F19<=0,0,1))=0,"SORTED","UNSORTED")

These formulas may be combined to test whether the data is sorted in either ascending or descending order:

=IF(OR(SUM(IF(F12:F20-F11:F19>=0,0,1))=0,SUM(IF(F12:F20-F11:F19<=0,0,1))=0),"SORTED","UNSORTED")

All of these formulas are Array Formulas, which means that you must press CTRL+SHIFT+ENTER rather than just ENTER when you first enter the formula and whenever you edit it later. If you do this properly, Excel will display the formula enclosed in curly braces {  }.

SectionBreak


Maximum Difference Between Two Adjacent Elements In A Series

The MaxDifferenceInSeries returns the maximum difference between two adjacent elements in a series. SeriesRange must be a sorted single column of numeric values. The function will return -1 if invalid data is found.

Function MaxDifferenceInSeries(SeriesRange As Range, _
    Optional Ascending As Boolean = True) As Double
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MaxDifferenceInSeries
' This function returns the maximum difference between two adjacent
' elements in a range of cells referenced by SeriesRange. SeriesRange
' must be a single column with only numbers and no blanks. If invalid
' data is found, the function returns -1. If the data is well ordered
' (sorted either ascending or descending as specified by the Ascending
' parameter), the function returns the maximum difference between two
' adjacenet elements.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim StartRow As Long
Dim EndRow As Long
Dim RowNdx As Long
Dim ColNum As Long
Dim V1 As Double
Dim V2 As Double
Dim MaxDiff As Double

If SeriesRange.Columns.Count > 1 Then
    MaxDifferenceInSeries = False
    Exit Function
End If

StartRow = SeriesRange.Cells(1, 1).Row

With SeriesRange
    EndRow = .Cells(.Cells.Count).Row
End With

ColNum = SeriesRange.Cells(1, 1).Column

With SeriesRange.Worksheet
    For RowNdx = StartRow To EndRow - 1 
        If IsNumeric(.Cells(RowNdx, ColNum)) = False Then 
            MaxDifferenceInSeries = -1
            Exit Function
        End If
        V1 = .Cells(RowNdx, ColNum).Value
        V2 = .Cells(RowNdx + 1, ColNum).Value 
        If Ascending = True Then
            If V1 > V2 Then 
                MaxDifferenceInSeries = -1
                Exit Function 
            End If
            If (V2 - V1) > MaxDiff Then
                MaxDiff = V2 - V1
            End If
        Else
            If V1 < V2 Then
                MaxDifferenceInSeries = -1
                Exit Function 
            End If
            If (V1 - V2) > MaxDiff Then
                MaxDiff = V1 - V2 
            End If
        End If
    Next RowNdx
    MaxDifferenceInSeries = MaxDiff

End With

End Function

SectionBreak


Minimum Differences Between Two Adjacent Elements In A Series

The MinDifferenceInSeries returns the minimum difference between two adjacent elements in a series. SeriesRange must be a sorted single column of numeric values. The function will return -1 if invalid data is found.

Function MinDifferenceInSeries(SeriesRange As Range, _
    Optional Ascending As Boolean = True) As Double
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MinDifferenceInSeries
' This function returns the minimum difference between two adjacent
' elements in a range of cells referenced by SeriesRange. SeriesRange
' must be a single column with only numbers and no blanks. If invalid
' data is found, the function returns -1. If the data is well ordered
' (sorted either ascending or descending as specified by the Ascending
' parameter), the function returns the minimum difference between to
' adjacenet elements.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim StartRow As Long
Dim EndRow As Long
Dim RowNdx As Long
Dim ColNum As Long
Dim V1 As Double
Dim V2 As Double
Dim MinDiff As Double

If SeriesRange.Columns.Count > 1 Then
    MinDifferenceInSeries = False
    Exit Function
End If

StartRow = SeriesRange.Cells(1, 1).Row

With SeriesRange
    EndRow = .Cells(.Cells.Count).Row
End With

ColNum = SeriesRange.Cells(1, 1).Column

On Error Resume Next
Err.Clear
With Application.WorksheetFunction
    MinDiff = .Max(SeriesRange) - .Min(SeriesRange)
    If Err.Number <> 0 Then 
        MinDifferenceInSeries = -1
        Exit Function
    End If
End With

With SeriesRange.Worksheet
    For RowNdx = StartRow To EndRow - 1
        If IsNumeric(.Cells(RowNdx, ColNum)) = False Then
            MinDifferenceInSeries = -1
            Exit Function
        End If
        V1 = .Cells(RowNdx, ColNum).Value
        V2 = .Cells(RowNdx + 1, ColNum).Value
        If Ascending = True Then
            If V1 > V2 Then
                MinDifferenceInSeries = -1
                Exit Function
            End If
            If (V2 - V1) < MinDiff Then 
                MinDiff = V2 - V1
            End If
        Else
            If V1 < V2 Then 
                MinDifferenceInSeries = -1
                Exit Function 
            End If
            If (V1 - V2) < MinDiff Then 
                MinDiff = V1 - V2
            End If
        End If
    Next RowNdx

    MinDifferenceInSeries = MinDiff

End With

End Function

You can download a bas file containing the funcitons shown above.

SectionBreak

 Using A Formula To Test Minimum And Maximum Differences

You can use an array formula to determine the minimum and maximum differences between adjacent elements in a series of numbers.

To get the minimum increment between the numbers in D11:D20, use

=MIN(ABS(D11:D19-D12:D20))

To get the maximum increment between the numbers in D11:D20, use

=MAX(ABS(D11:D19-D12:D20))

Both of these formulas are array formulas, and therefore you must press CTRL+SHIFT+ENTER rather than just ENTER when you first enter the formula and whenever you edit it later. If you do this properly, Excel will display the formula enclosed in curly braces { }.

You can read more about array formulas here.

This page last udpated: 13-July-2007

-->