In many of my VBA projects, I need to loop through a range of cells and break up a large dataset into smaller datasets, typically moving the subsets of data to their own worksheets. Many times, the range of data I need to loop through is the distinct list of items in a particular column. In this post, I will demonstrate how to create a unique list of items for a given column, then copy the range into an Array for further action and processing.
Excel VBA – Copy Range into Array – Setup
Here is the macro code:
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
ActiveSheet.Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell.End(xlToRight).Offset(0, 1), Unique:=True
Dim Arr() As Variant
Arr = Range(ActiveCell, ActiveCell.End(xlDown))
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' Row
For C = 1 To UBound(Arr, 2) ' Column
MsgBox Arr(R, C), , "Array Value"
Let’s say you have the following table. I encourage you to copy the contents into a new Excel workbook, and step through the code above:
When executing the code above, the macro will first sort the table by column B and filter column B for unique values, copying the results into column D.
Results in the unique values of column B being copied into column D:
From there, the next block of code actually creates the Array:
Lastly, the code for looping through the Array values:
presents each value in a Message Box:
This comes in handy when you are trying to loop through unique values in a given column, which allows further action based on these unique values. I often use this code when I need to take a table and create new worksheets based on the unique value of a specific column.
You can modify this macro to meet your needs.