Split and write in cell in VBA - excel

Question

I get some unclean data from a text file, and in the text file, I process it as per the data in the VBA script, which gives the following output.
This is the Raw String.
1* student 1*2018-01-01*1*1234122
2* student 2*2017-01-01*1*54654654234
3* student 3*2015-01-01*4*54234654654
4* student 4*2012-01-01*5*546542345654
I wanted the output in different cells, as mentioned below in any open worksheet in excel.
Roll No
Student Name
Date of Birth
class
phone
1
student 1
2018-01-01
1
1234122
2
student 2
2017-01-01
1
54654654234
3
student 3
2015-01-01
4
54234654654
4
student 4
2012-01-01
5
546542345654
I tried various sources but couldn't get the expected output.
Any help will be appreciated.

Answer 1

Please, try the next way. It assumes that the whole text you show is in a single cell, not in different linens. But the above way will also deal with a single row:
Sub extractTextDelimSep()
Dim x As String, arr, arrLine, arrFin, cols As Long, i As Long, j As Long
x = "1* student 1*2018-01-01*1*1234122" & vbCr & _
"2* student 2*2017-01-01*1*54654654234" & vbCr & _
"3* student 3*2015-01-01*4*54234654654" & vbCr & _
"4* student 4*2012-01-01*5*546542345654"
arr = Split(x, vbCr) 'split the rows
cols = UBound(Split(arr(0), "*")) + 1 'determine the columns number per row
ReDim arrFin(1 To UBound(arr) + 1, 1 To cols) 'ReDim the final array
For i = 0 To UBound(arr)
arrLine = Split(Replace(arr(i), " ", ""), "*")
For j = 0 To UBound(arrLine)
arrFin(i + 1, j + 1) = arrLine(j)
Next j
Next i
Range("B2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
End Sub
Instead using x as a built string you my have the string in a cell and you can use x = ActiveCell.value.
It is easy to transform the above code in a function, too...
Edited:
You can use the next function:
Function extractTextDelimSep(x As String) As Variant
Dim arr, arrLine, arrFin, cols As Long, i As Long, j As Long
arr = Split(x, vbCr)
cols = UBound(Split(arr(0), "*")) + 1
ReDim arrFin(1 To UBound(arr) + 1, 1 To cols)
For i = 0 To UBound(arr)
arrLine = Split(Replace(arr(i), " ", ""), "*")
For j = 0 To UBound(arrLine)
arrFin(i + 1, j + 1) = arrLine(j)
Next j
Next i
extractTextDelimSep = arrFin
End Function
If everything is in the same cell (in column A:A), you should call it in the next way:
Sub TestextractTextDelimSep()
Dim x As String, arr
x = ActiveCell.Value
arr = extractTextDelimSep(x)
'drop the array content at once:
Range("B" & ActiveCell.row).Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
If the string is distributed one line of a (different) cell, you can use:
Sub TestextractTextDelimSepRange()
Dim lastR As Long, arr, i As Long
lastR = Range("A" & rows.count).End(xlUp).row
For i = 1 To lastR
arr = extractTextDelimSep(Range("A" & i).Value)
Range("B" & i).Resize(1, UBound(arr, 2)).Value = arr
Next i
End Sub
For this last case, in Excel 365 it can be used as UDF function, being called from the cell as formula:
=extractTextDelimSep(A1) 'in A1 should be the line to be split