Author: Oscar Cronquist Article last updated on August 15, 2012

Jinesh asks:

I have to combine 200 columns into one list. I know. I tried steps from 'Combine cell ranges into a single range while eliminating blanks' UDF, but looks like typing the formula itself is going to be a big deal. Any advice?

(To give a bit of a background, I am trying to compare 200 columns to one column of data and figured it would be easier if I combine all 200 into one column and then compare, it would be easy).


The following macro moves from column to column and checks for values. If a value is found, the current region property (Ctrl + A) is applied and the cell range address is saved. A new sheet is created and all unique distinct cell references are concatenated using a delimiting character into cell A1.

The current region is a range bounded by any combination of blank rows and blank columns. In other words, the macro creates cell references to all cell ranges populated with values.

VBA Code

Sub ExtractAddresses()
Dim sht As Worksheet
Dim CurCell As Range
Dim Adr As New Collection
Dim c As Single
Dim Value As Variant
Dim result As String, delch As String
delch = InputBox("Delimiting character:")
Set CurCell = ActiveSheet.Range("A1")
For c = 1 To Columns.Count - 1
    Set CurCell = CurCell.End(xlDown)
    Do While CurCell.Value <> ""
        If Len(CurCell.CurrentRegion.Address) > 0 Then
            On Error Resume Next
            Adr.Add CurCell.CurrentRegion.Address, CStr(CurCell.CurrentRegion.Address)
            On Error GoTo 0
        End If
        If CurCell.Row = Rows.Count Then Exit Do
        Set CurCell = CurCell.End(xlDown)
        Set CurCell = Range("A1").Offset(0, c)
Next c
For Each Value In Adr
    result = result & delch & Value
Next Value
Set sht = Sheets.Add
sht.Range("A1") = Right(result, Len(result) - 1)
End Sub

Download excel *.xlsm file

Extract all addresses from cell ranges populated with values.xlsm