Segregate data by data types

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