Inserting Rows Or Cells And Filling Missing Entries In A Series

         This page describes a VBA procedure that you can use to insert rows or cells and fill in missing elements of a series of numbers. Suppose you have a partial series of numbers in a range of cells.  This code will detect missing entries in the series, insert the appropriate number of rows or cells between the existing entries in the series, and fill those cells with the appropriate values.

 
 
 
For example, in the range shown on the far left, the values 2, 3, 6, and 9 are missing from the series of integers in rows 1 through 6.  The code shown below will insert the required cells or rows, and then fill in the missing values.  After running the code, the result is as shown in the picture on the near left. The values 2, 3, 6, and 9 have been inserted into the series. In this example, the series increment was 1.  However, you are not restricted to a series with an increment of 1. The code shown below will properly handle an series increment of any value, including fractional numbers. Unlike the example, the series need not begin in row 1. It may begin in any row.

There are two restrictions on the initial data series. First, the existing values must be in ascending order with no interspersed blank cells. Second, the existing values must be round integer multiples of the series increment value. If the existing values do not meet these requirements, the results are undefined.

  
  The procedure declaration follows:
    Function InsertAndFillMissingNumbers(RangeToTest As Range, FillStep As Double, _
        Optional FullRows As Boolean = False) As Range

where

RangeToTest is the range containing the actual values themselves, not the range into which the series will be expanded. In the picture on the far left above, the RangeToTest in D1:D6.  RangeToTest must be a range with a single column. The function will terminate if RangeToTest contains more than one column. The cells in RangeToTest must be non-blank, numeric, and be in ascending order.  RangeToTest may be a single cell, but in this case nothing will happen. The result of the function will be the same range as RangeToTest.

FillStep is the increment to use when filling the inserted cells. The existing values in the RangeToTest must be integer multiples of FillStep.  FillStep may be a fractional number, such as 1.5.  If the existing values are not integer multiples of FillStep, the results are undefined.

FullRows indicates whether to insert entire rows or just cells in the column. If FullRows is omitted or False, then only cells within the column of RangeToTest are inserted. If FullRows is True, entire rows are inserted.

If all the parameters are correct and the RangeToTest is proper, then the function will return a Range object referring to the expanded range. In the example above, the result of the function is the range D1:D10. If an error occurs, the function returns Nothing.

The complete code is shown below:

Function InsertAndFillMissingNumbers(RangeToTest As Range, FillStep As Double, _
     Optional FullRows As Boolean = False) As Range

Dim BottomRow As Long
Dim TopRow As Long
Dim NumToInsert As Long
Dim RowNdx As Long
Dim WS As Worksheet
Dim ColNum As Long
Dim StartRng As Range
Dim EndRng As Range
Dim Rng As Range

''''''''''''''''''''''''''''''
' Ensure RangeToTest is not
' nothing.
''''''''''''''''''''''''''''''
If RangeToTest Is Nothing Then
    Exit Function
End If
'''''''''''''''''''''''''''''''''''''
' Ensure RangeToTest is a single
' column.
'''''''''''''''''''''''''''''''''''''
If RangeToTest.Columns.Count > 1 Then
    Exit Function
End If
''''''''''''''''''''''''''''''''''''
' Ensure that there is at least
' one non-blank cell in RangeToTest.
''''''''''''''''''''''''''''''''''''
If Application.WorksheetFunction.Count(RangeToTest) = 0 Then
    Exit Function
End If
'''''''''''''''''''''''''''''''''''''
' Ensure that all cell values are
' numeric and not blank.
'''''''''''''''''''''''''''''''''''''
For Each Rng In RangeToTest.Cells
    If Rng.Value = vbNullString Then
        Exit Function
    End If
    If IsNumeric(Rng.Value) = False Then
        Exit Function
    End If
Next Rng

'''''''''''''''''''''''''''''''''''
' Set some variable values.
'''''''''''''''''''''''''''''''''''
With RangeToTest
    Set WS = .Worksheet
    Set StartRng = .Cells(1, 1)
    Set EndRng = .Cells(.Cells.Count)
    TopRow = .Cells(1, 1).Row
    BottomRow = .Cells(.Cells.Count).Row
    ColNum = .Column
End With
''''''''''''''''''''''''''''''
' If the bottom cell is empty
' move it up to the last
' non-blank cell.
''''''''''''''''''''''''''''''
With WS
    If .Cells(BottomRow, ColNum).Value = vbNullString Then
        BottomRow = .Cells(BottomRow, ColNum).End(xlUp).Row
    End If
End With
''''''''''''''''''''''''''''''''''''''''''''''
' Loop RowNdx from the bottom cell upwards,
' with a step of -1.
''''''''''''''''''''''''''''''''''''''''''''''
For RowNdx = BottomRow To (TopRow + 1) Step -1
    With WS
        If .Cells(RowNdx, ColNum).Value - FillStep <> .Cells(RowNdx - 1, ColNum).Value Then
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' The Cell value - FillStep is not equal to the value
            ' of the cell above it. We need to insert one or more
            ' rows. Compute the number of rows to insert. Note that
            ' the division at the end of this line is integer
            ' division ( the \ operator, not the / operator).
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            NumToInsert = (Abs(.Cells(RowNdx, ColNum).Value - .Cells(RowNdx - 1, ColNum).Value) - FillStep) \ FillStep
            If NumToInsert <> 0 Then
                If FullRows = True Then
                    ''''''''''''''''''''''''''''''''''''''
                    ' Insert complete rows.
                    ''''''''''''''''''''''''''''''''''''''
                    .Rows(RowNdx).Resize(NumToInsert).Insert
                Else
                    '''''''''''''''''''''''''''''''''''''''
                    ' Insert only cells in the RangeToTest
                    ' column.
                    '''''''''''''''''''''''''''''''''''''''
                    .Cells(RowNdx, ColNum).Resize(NumToInsert).Insert shift:=xlDown
                End If
                ''''''''''''''''''''''''''''''''''''''''''''''
                ' Put the next value in the first inserted
                ' cell. Then user DataSerise to fill down
                ' the rest of the new values.
                ''''''''''''''''''''''''''''''''''''''''''''''
                .Cells(RowNdx, ColNum).Value = .Cells(RowNdx - 1, ColNum) + FillStep
                .Cells(RowNdx, ColNum).Resize(NumToInsert, 1).DataSeries rowcol:=xlColumns, Type:=xlLinear, Step:=FillStep
            End If
        End If
    End With
Next RowNdx

''''''''''''''''''''''''''''''''''''''
' Return the result range. EndRng
' was set to the bottom of RangeToTest
' and was moved down as a result of the
' inserts, so it is now at the end of
' the expanded range.
'''''''''''''''''''''''''''''''''''''''
Set InsertAndFillMissingNumbers = Range(StartRng, EndRng)

End Function

Finding A Series That Sums To A Specific Value

The procedure below is only tangentially related to previous topic on this page, but I couldn't think where else to put it. This procedure will find a contiguous range of cells in column A that sum to the value in cell B1.  It will scan down column A until it finds a set of contiguous cells that sum to the value in B1 or until a blank cell is encountered in column A, in which case there is no series that sums to the value in B1. If there is more than one series that sums to B1, only the first such series is found. The range of the series, if found, is highlighted. 

    Sub FindSeries()
    
    Dim StartRng As Range
    Dim EndRng As Range
    Dim Answer As Long
    Dim TestTotal As Long
    
    Answer = Range("B1") '<<< CHANGE
    
    Set StartRng = Range("A1")
    Set EndRng = StartRng
    Do Until False
        TestTotal = Application.Sum(Range(StartRng, EndRng))
        If TestTotal = Answer Then
            Range(StartRng, EndRng).Select
            Exit Do
        ElseIf TestTotal > Answer Then
            Set StartRng = StartRng(2, 1)
            Set EndRng = StartRng
        Else
            Set EndRng = EndRng(2, 1)
            If EndRng.Value = vbNullString Then
                MsgBox "No series found"
                Exit Do
            End If
        End If
    Loop
    End Sub

Testing If A Column Of Numbers Is A Valid Series

You can use the formula below to determine if all the entries in a specified range are in the correct series order. That is, whether they are equally spaced, with a specified step increment. In the formula, TheRange is the range of cells to test, and Step is the correct increment between items N and N+1 of the series, going downward in the column of numbers. The formula will return 0 if all the items are separated by the value of Step. For example, if A1:A5 is 2, 4, 6, 8, 10 and Step is 2, the result is 0, indicating that all values are separated by Step. If A1:A5 is 2, 5, 8, 10, 12, the result is 2, indicating that, moving downwards, 2 items (5 and 8 in this example) are not separated by Step. The Step increment should be positive for series in ascending order or negative for series in descending order.

This is an array formula, so you must press CTRL+SHIFT+ENTER rather than just ENTER after you type the formula and whenever you edit it later. If you do this properly, Excel will display the formula enclosed in curly braces { } in the formula bar.  Click here for more information about working with array formulas.

Note that the formula is split in to two lines here for display purposes. When copied to Excel, the formula should be a single line.

=SUM(IF(OFFSET(TheRange,1,0,ROWS(TheRange)-1,1)=
  OFFSET(TheRange,0,0,ROWS(TheRange)-1,1)+Step,0,1))

If you prefer to use cell references instead of a defined name, use a formula like

=SUM(IF(A2:A10=A1:A9+B1,0,1))

where A1:A10 contains the value to be test and B1 contains the Step value.  Note that the first range is A2:A10 and second range is A1:A9. Like the previous formula, this formula must be entered with CTRL+SHIFT+ENTER rather than just ENTER.