Extraer valores únicos de rangos discontinuos

Esta nota trata sobre cómo extraer valores únicos de rangos que contienen más de una columna o rangos discontinuos.

Excel tiene dos métodos incorporados para esta tarea. En Excel 2007-2013 ambos se encuentran en la pestaña Datos: Filtro Avanzado y Quitar duplicados

Filtro Avanzado nos permite hacerlo con relativa facilidad usando la posibilidad, como mostramos en este video:



Con Quitar duplicados la técnica es un poco más elaborada, ya que incluye copiar la lista a un rango apartado y allí extraer los duplicados (si estamos interesados en guardar la lista original)




Las limitaciones de estos métodos comienzan cuando queremos extraer valores únicos de rangos discontinuos o de rangos que contienen más de una columna.

Podemos hacerlo con un código relativamente sencillo, similar al que mostramos en la nota sobre listas desplegables dependientes publicada hace poco. Este código se basa en el objeto Collection. El código es el siguiente


Sub extraerUnicos_Hoja()
'extraer valores unicos de rangos de varias columnas o no continuos
'Jorge Dunkelman - JLD Excel Blog, mayo 2013

    Dim collUnicos As New Collection
    Dim vcollItem As Variant
    Dim rngCell As Range, rngDatos As Range, rngLista As Range
    Dim lCounter As Long
 
    Set rngDatos = Application.InputBox(prompt:="Seleccione rango/s con datos", Type:=8)
    Set rngLista = Application.InputBox(prompt:="Seleccione la primera celda de la lista", Type:=8)
 
    On Error Resume Next
    For Each rngCell In rngDatos
        collUnicos.Add rngCell, Cstr(rngCell)
    Next rngCell
    On Error GoTo 0
 
    lCounter = 0
    For Each vcollItem In collUnicos
        rngLista.Offset(lCounter, 0) = CStr(vcollItem)
        lCounter = lCounter + 1
    Next vcollItem
 
End Sub


Con este código definimos el rango que contiene los datos (que puede contener varias columnas o ser discontinuo, pero todos los datos deben estar en la misma hoja), definimos la celda desde donde queremos empezar a pegar la lista de registros únicos y el código la genera.

Por ejemplo, en esta matriz de 6 filas por tres columnas (18 valores) donde hay 5 valores únicos (a, b, c, d y e)



Para que este código sea realmente útil debemos agregar algunas líneas para manejar errores que pueden ocurrir durante el proceso (por ejemplo, si el usuario selecciona un rango de datos con una sola celda o si aprieta el botón Cancel del InputBox). El código completo es el siguiente

Sub extraerUnicos_Hoja()
'extraer valores unicos de rangos de varias columnas o no continuos
'Jorge Dunkelman - JLD Excel Blog, mayo 2013

    Dim collUnicos As New Collection
    Dim vcollItem As Variant
    Dim rngCell As Range, rngDatos As Range, rngLista As Range
    Dim lCounter As Long
 
    On Error GoTo errCancel 'si se aprieta Cancel
 
    Set rngDatos = Application.InputBox(prompt:="Seleccione rango/s con datos", Type:=8)
    If rngDatos.Count < 2 Then
        MsgBox "Debe seleccionar un rango con mas de dos celda", vbCritical
        Exit Sub
    End If
 
    Set rngLista = Application.InputBox(prompt:="Seleccione la primera celda de la lista", Type:=8)
    If rngLista.Count <> 1 Then
        MsgBox "Seleccione solamente una celda", vbCritical
        Exit Sub
    End If
 
    On Error Resume Next
    For Each rngCell In rngDatos
        collUnicos.Add rngCell, Cstr(rngCell)
    Next rngCell
    On Error GoTo 0
 
    lCounter = 0
    For Each vcollItem In collUnicos
        rngLista.Offset(lCounter, 0) = CStr(vcollItem)
        lCounter = lCounter + 1
    Next vcollItem
 
    Exit Sub
 
errCancel:
Exit Sub
End Sub