Segregate data by data types - excel

Question

I have some data (mixed data types in column A). How can I split each data type into another column?
I mean numbers to be in column, string in column, dates in column and so on
This is my try till now but I didn't get all the results as expected
Sub Test()
Dim a, b(), dic As Object, i As Long, k As Long, ii As Long, n As Long
a = Range("A1:A10").Value
Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(a) To UBound(a)
If Not dic.Exists(VarType(a(i, 1))) Then
dic.Item(VarType(a(i, 1))) = Empty
ReDim Preserve b(UBound(a, 1), k)
k = k + 1
End If
n = 0
Do Until b(i - 1, k - 1) <> Empty
b(i - 1, k - 1) = a(i, 1)
Loop
Next i
Range("J1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Answer 1

There are a number of things I would do differently in your code
using meaningful names for the variables
specifying the worksheet instead of depending on the implied ActiveSheet
clearing the results area on the worksheet
early binding of the dictionary object
dynamic determination of the range to be processed
etc
but the below code modifies your original code minimally, to obtain the output I think you want, based on your screenshot
Sub Test()
Dim a, b(), dic As Object, i As Long, k As Long, ii As Long, n As Long, v
Dim dataType As String
a = Range("A1:A10").Value
ReDim b(1 To UBound(a))
'first create the dictionary with the datatypes
'since you are maintaining the entries in the same rows,
' add an empty array as the item
Set dic = CreateObject("Scripting.Dictionary")
dic.Add Key:="number", Item:=b
dic.Add Key:="date", Item:=b
dic.Add Key:="string", Item:=b
dic.Add Key:="logical", Item:=b
'Add the values to the correct dictionary item
' at the correct spot in the array
For i = LBound(a) To UBound(a)
Select Case VarType(a(i, 1))
Case 2 To 6
dataType = "number"
Case 7
dataType = "date"
Case 8
dataType = "string"
Case 11
dataType = "logical"
Case Else
dataType = ""
End Select
If dataType <> "" Then
v = dic(dataType)
v(i) = a(i, 1)
dic(dataType) = v
End If
Next i
'Next create output array
ReDim b(1 To UBound(a), 1 To dic.Count)
k = 0
For Each v In dic.Keys
k = k + 1
For i = 1 To UBound(dic(v))
b(i, k) = dic(v)(i)
Next i
Next v
Range("J1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub
Edit:
If, as you indicate in your comments, you don't want to set up the data types initially, you can also do that at the time of creation of the dictionary object. Using the same algorithm of storing the item as an array of the same size as the number of rows in the data base:
Sub Test()
Dim a, b(), dic As Object, i As Long, k As Long, ii As Long, n As Long, v
Dim dataType As Long
a = Range("A1:A10").Value
ReDim b(1 To UBound(a))
Set dic = CreateObject("Scripting.Dictionary")
'Add the values to the correct dictionary item
' at the correct spot in the array
For i = LBound(a) To UBound(a)
dataType = VarType(a(i, 1))
If a(i, 1) <> "" Then
If Not dic.Exists(dataType) Then
ReDim b(UBound(a))
b(i) = a(i, 1)
dic.Add Key:=dataType, Item:=b
Else
b = dic(dataType)
b(i) = a(i, 1)
dic(dataType) = b
End If
End If
Next i
'Next create output array
ReDim b(1 To UBound(a), 1 To dic.Count)
k = 0
For Each v In dic.Keys
k = k + 1
For i = 1 To UBound(dic(v))
b(i, k) = dic(v)(i)
Next i
Next v
Range("J1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub