Data Blocks On Worksheets

This page describes VBA code for working with blocks of data on a worksheet.

Introduction

It is very common in Excel to have a list of data that is logically separated into blocks based on content and value or by the presence some some marker, such as a blank line. Often, you will need to determine the extent of each data block and then perform some action on the block. This page describes VBA code that you can use to create an array for Range objects, each of when reference one block of data in a larger range. The image below illustrates a simple yet common data setup. Department names are grouped together and a person is associate with a department.

One of the several procedures presented on this page will create an array for Range objects, each of which contains all elements of a deparment.

Blocking By Equal Content

This first code example requires that the data be grouped together (e.g., all Accounting elements are in contiguous rows) and that there are no empty cells in the full data list. The code ignores any blank cells at the top of the data list and begins processing the cells at the first non-blank cell. The presence of an empty cell after the data indicates the end of the data and processing halts. The code is shown below.

Sub ValueBasedBlocksNoSpaces()
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' ValueBasedBlocksNoSpaces
    ' This creates the Blocks() array of Ranges where
    ' each range contains elements with the same name.
    ' It is assumed that there are no blank cells within
    ' the list.
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Blocks() As Range
    Dim R1 As Range
    Dim R2 As Range
    Dim LastRow As Long
    Dim N As Long
    
    Set R1 = Range("A7") '<<<< START OF DATA
    Set R2 = R1
    With R1.Worksheet
        ' Change the column letter below from 'A' to the column
        ' that is used to determine the last row of data.
        ' This need not be the same column of the range
        ' assigned to R1 above.
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    Do Until R1.Value <> vbNullString
        Set R1 = R1(2, 1)
        If R1.Row > LastRow Then
            Exit Sub
        End If
    Loop
    
    ReDim Blocks(1 To LastRow)
    Do Until R1.Row > LastRow
        Do Until R1.Value <> R2.Value
            Set R2 = R2(2, 1)
        Loop
        N = N + 1
        Set Blocks(N) = Range(R1, R2(0, 1))
        Set R1 = R2
    Loop
    
    ReDim Preserve Blocks(1 To N)
    '''''''''''''''''''''''''''''''''''''''''''''''
    ' The formal code ends here. What follows is
    ' just for illustration and testing.
    '''''''''''''''''''''''''''''''''''''''''''''''
    For N = LBound(Blocks) To UBound(Blocks)
        For Each R1 In Blocks(N).Cells
            With R1(1, 2)
                .Value = "Block " & CStr(N)
                .Font.ColorIndex = 15
            End With
        Next R1
        Debug.Print N, Blocks(N).Address
    Next N
End Sub

This code results in the following. The origin data column is in the left column and the right column is the block number, used only for illustration and testing.

Blocking By Empty Cells In Value Column

Sub BlankDelimitedBlocksIncludeTrailingBlanks()
    Dim Blocks() As Range
    Dim R1 As Range
    Dim R2 As Range
    Dim LastRow As Long
    Dim N As Long
    Dim Done As Boolean
    
    Set R1 = Range("D7") '<<<< START OF DATA
    Set R2 = R1
    With R1.Worksheet
        LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    End With
    Do Until R1.Value <> vbNullString
        Set R1 = R1(2, 1)
        If R1.Row > LastRow Then
            Exit Sub
        End If
    Loop
    
    ReDim Blocks(1 To LastRow)
    Do Until R1.Row > LastRow
        Do Until (R1.Value <> R2.Value) And (R2.Value <> vbNullString)
            Set R2 = R2(2, 1)
            If R2.Row > LastRow Then
                Exit Do
            End If
        Loop
        N = N + 1
        Set Blocks(N) = Range(R1, R2(0, 1))
        Set R1 = R2
    Loop
    
    ReDim Preserve Blocks(1 To N)
    
    '''''''''''''''''''''''''''''''''''''''''''''''
    ' The formal code ends here. What follows is
    ' just for illustration and testing.
    '''''''''''''''''''''''''''''''''''''''''''''''
    For N = LBound(Blocks) To UBound(Blocks)
        For Each R1 In Blocks(N).Cells
            With R1(1, 2)
                .Value = "Block " & CStr(N)
                .Font.ColorIndex = 15
            End With
        Next R1
        Debug.Print N, Blocks(N).Address
    Next N
    
End Sub

Another Section

Narrative goes here.

This page last updated: 28-Oct-2008.