Determine and list all values within a given range and list in one cell as a comma delimited value

Question

I am trying to find a way to list unique values in a given year range, and list the results in one cell as a comma delimited value. In the example below, Column A contains the data that I have, and Column B is the desired result.

Column A  | Column B
2007-2010 | 2007,2008,2009,2010
1999-2001 | 1999,2000,2001

The direction that I was thinking about going in was to find the difference between the two numbers and fill series from the first number based on the difference. Then concatenate the values in one cell with a comma delimiter. So, based on that, here is what I have so far:

LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],4)-LEFT(RC[-1],4)"
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B" & LR), Type:=xlFillDefault
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-2],4)"
    Range("C1").Select
    Selection.AutoFill Destination:=Range("C1:C" & LR), Type:=xlFillDefault

I am not married to this approach, so feel free to steer me in a different direction.

Thanks in advance!

Answer 1

Straight VBA answer like this. Change rStart to be the first cell of your data:

Sub SplitYears()
Dim rStart As Range, lRow As Long, lYear1 As Long, lYear2 As Long

    Set rStart = Sheet3.Range("A1")
    lRow = 0

    Do While rStart.Offset(lRow, 0).Value <> ""
' Get start and end year
        lYear1 = CLng(Left(rStart.Offset(lRow, 0).Value, 4))
        lYear2 = CLng(Right(rStart.Offset(lRow, 0).Value, 4))
        With rStart.Offset(lRow, 1)
            .ClearContents
            .NumberFormat = "@"
' Append each year with comma
            Do While lYear1 <= lYear2
                .Value = .Value & lYear1 & ","
                lYear1 = lYear1 + 1
            Loop
' Lose final comma
            .Value = Left(.Value, Len(.Value) - 1)
        End With

        lRow = lRow + 1
    Loop
End Sub