How To Create Blocks In Excel

ThreeWave Data Blocks On Worksheets

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

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.

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()          Dim Blocks() As Range     Dim R1 As Range     Dim R2 As Range     Dim LastRow As Long     Dim N As Long          Set R1 = Range("A7")      Set R2 = R1     With R1.Worksheet                  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)          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.

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")      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)               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

SectionBreak