Extract unique values in a column that end in "ago"

**blinks58** · 02-06-2013, 01:32 AM

I have a column in Excel that reads like:

1 year ago
1990
2 years ago
1993
1990
1 year ago

I want to extract into another column only those unique values that end in "ago", viz:

1 year ago
2 years ago

I can do it using a macro, but this is inefficient as it creates 1024K blank lines in the spreadsheet when there are only about 100 filled lines.

Any suggestions on how to do this with VB instead?

TIA

**nilem** · 02-06-2013, 01:54 AM

Hi blinks58
try it (assumes that your data is in column A)

Sub ertert()
Application.ScreenUpdating = False
Rows(1).Insert
[a1] = "temp": [d1] = "temp": [d2] = "*ago"
With Range("A1", Cells(Rows.Count, 1).End(xlUp))
    .AdvancedFilter 2, Range("D1:D2"), Range("B1"), True
End With
Rows(1).Delete: [d1] = ""
Application.ScreenUpdating = True
End Sub

**jindon** · 02-06-2013, 01:58 AM

And example


Sub test()
    Dim x
    With Range("a1", Range("a" & Rows.Count).End(xlUp))
        x = Filter(Evaluate("transpose(if(right(" & .Address & ",3)=""ago"",if(countif(offset(" & .Address & _
        ",0,0,row(1:" & .Rows.Count & "))," & .Address & ")=1," & .Address & ",char(2)),char(2)))"), Chr(2), 0)
    End With
    If UBound(x) <> -1 Then MsgBox Join$(x, vbLf)
End Sub

**Trebor76** · 02-06-2013, 02:12 AM

Hi blinks58,

Like the above suggestions, I'd say VBA is the way to go. That said, here's my attempt:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim clnMyUniqueValues As New Collection
    Dim rngCell As Range
    Dim strOutputCol As String
    
    strOutputCol = "B" ' Output column for unique values. Change to suit.
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Range("A2", Range("A" & Rows.Count).End(xlUp)) 'Searches from cell A2 down to the last entry in column A. Change to suit.
    
        If InStr(rngCell, "ago") > 0 Then
        
            On Error Resume Next
                clnMyUniqueValues.Add rngCell, CStr(rngCell)
                If Err.Number = 0 Then
                    Cells(Cells(Rows.Count, strOutputCol).End(xlUp).Row + 1, strOutputCol).Value = rngCell
                End If
                Err.Clear
            On Error GoTo 0
            
        End If
    
    Next rngCell
    
    Application.ScreenUpdating = True

End Sub

HTH

Robert