Tom’s Tutorials For Excel: Listing Unique Items From Multiple Ranges

Tom’s Tutorials For Excel: Listing Unique Items From Multiple Ranges

Here’s a method for looping through possible named ranges, and if they exist, compiling a unique list of items found among all those ranges.

I have the word “possible” here as a design wrinkle to demonstrate an option of convenience. On a sheet you can keep hidden, you can maintain a list of named ranges that truly exist, while including names of ranges that don’t exist yet but which you’re thinking of including in the future. This first picture shows such a sheet, with a simple list of named ranges.



For your worksheet with the actual named ranges, the below macro lists all unique items in column J that were collected from each named range. This next picture is an example of three named ranges that are populated with many repeated items.

Sub ListUniqueItemsFromMultipleRanges()

'Turn off ScreenUpdating.
Application.ScreenUpdating = False

'Declare variables.
Dim RangeCell As Range, cell As Range
Dim xRow As Long, varCell As Variant

'The list will go into column J which is column 10.
'Clear that column to make sure you start with a clean slate.
Columns(10).Clear

'Put a header in cell J1 and bold the cell.
With Range("J1")
.Value = "Unique List"
.Font.Bold = True
End With

'Start the unique list in row 2 of column J.
xRow = 2

'Loop through each range name listed on the zzzNamedRangeList sheet.
'Some names will be valid, others will not be.
'This gives you an easy way to add named ranges to the list,
'to be included in the future, not necessarily today.
For Each RangeCell _
In Sheets("zzzNamedRangeList").Range("A1").CurrentRegion

'Test if the named range actually exists.
On Error Resume Next
If Not ActiveWorkbook.Names(RangeCell.Value) Is Nothing Then
If Err.Number <> 0 Then
Err.Clear

Else

'The named range exists. Loop through each cell.
For Each cell In Range(RangeCell.Value)

If Len(cell.Value) > 0 Then
'Determine of the item in the cell already exists in the
'unique list being compiled in column J.
'If it does not, add it to the next empty row in the list.
varCell = Application.Match(cell.Value, Columns(10), 0)
If IsError(varCell) Then
Err.Clear
Cells(xRow, 10).Value = cell.Value
xRow = xRow + 1
End If
End If
Next cell

End If
End If

Next RangeCell

'Optional, sort the unique list in column J by ascending order.
Range("J1").CurrentRegion.Sort _
Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes

'Turn on ScreenUpdating.
Application.ScreenUpdating = True
End Sub