Listas de Validación en Excel

Bueno este tema no es nada nuevo en la red, y el único propósito de este tema es afinarlo con respecto a como crear estas listas desde las famosas Macros de Excel.
Entendamos primero que una lista de validación es un tipo ComboBox que contiene valores provenientes de una celda o conjunto de celdas por ejemplo:

las celdas A1:A5 tienes los valores, "carro", "autobus", "bicicleta" y la lista de validación la queremos crear en la celda b4. Para ello aqui les dejo la Macro que realiza estas operaciones..

nota: las celdas mencionadas no corresponden con el ejemplo. pero tiene la misma funcionalidad


Sub recuperaTemas()


'Declaracion de variables
Dim celda As Range
Dim ElementosLista As New Collection
Dim Item As Variant
Dim texto As String
Dim cadenaSplit As Variant
Dim i As Integer
Dim numeroRegistros As Integer
Dim columna As String
Dim rangoValores As String

'Obtenemos valores de celdas y eliminamos registros vacios
For Each celda In Worksheets(1).Range("IP:IP")
If celda.Value <> "" Then
ElementosLista.Add celda.Value
End If

Next celda

'Limpiar columna de ayuda
Sheets.Item("Datos_del_Libro").Range("HW:HW").Clear

'Obtenemos el numero de registros obtenidos de las celdas
numeroRegistros = ElementosLista.Count

'Recorremos Coleccion de Elementos y los pegamos en la hoja -pega-
For k = 1 To numeroRegistros
columna = "HW" & (k) 'Especificamos en que celda queremos los valores
Worksheets("Datos_del_Libro").Range(columna).Value = ElementosLista.Item(k)
Next k


If numeroRegistros >= 1 Then
'Ahora creamos Cadena para Rango de Valores
rangoValores = "=Datos_del_Libro!$HW$1:$HW$" & numeroRegistros

ActiveSheet.Range("A4:A65000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=rangoValores
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = "Introduzca un valor establecido en la lista"
.ShowInput = True
.ShowError = True
End With

End If


End Sub

Explicación de Macro:
Primero obtenemos los datos de provenientes de un rango de celdas y los agregamos a una colección y eliminando celdas en blanco.

For Each celda In Worksheets(1).Range("IP:IP")
If celda.Value <> "" Then
ElementosLista.Add celda.Value
End If
Next celda

A continuaciòn insertamos los valores de esa coleccion es otro rango de celdas
For k = 1 To numeroRegistros
columna = "HW" & (k) 'Especificamos en que celda queremos los valores
Worksheets("Datos_del_Libro").Range(columna).Value = ElementosLista.Item(k)
Next k
ahora con los datos que se insertaron en el nuevo rango de valores, obtenemos ese nuevo rango de valores
rangoValores = "=Datos_del_Libro!$HW$1:$HW$" & numeroRegistros

Y por ultimo creamos la lista de validaciòn con ese nuevo rango de valores

ActiveSheet.Range("A4:A65000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=rangoValores
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = "Introduzca un valor establecido en la lista"
.ShowInput = True
.ShowError = True
End With

End If