Splitting Data Into Separate Cells

Hi,
I need help splitting up the data in one cell into separate cells. This is probably really basic but I have tried using Text To Columns and Left-Mid-Right functions but cannot seem to make anything work. Attached is an example of what I am working with. Thanks in advance for your help!
Thanks

Hi CK76,
To answer your question below. If it returned some kind of error that would be great. The macro works great.
Thanks

"However, there is 1 exception that I see in your data.
Row 20 has following data:
VT 2.2-5.0, VT1-2.5

How should this line be treated?"

Try: in B2 and drag across and down

Formula:

=IFERROR(MID($A2,SEARCH(E$1,$A2)+4,IFERROR(SEARCH(",",$A2,SEARCH(E$1,$A2)),SEARCH(E$1,$A2)+8)-SUM(SEARCH(E$1,$A2)+4)),"")

THANK YOU for everyone's help. Your solutions helped me out greatly. Thanks again.

Try below code then. It will put Error message in VT3 column.

Sub SplitData()
Dim resArr, x
Dim i As Integer, j As Integer
myArray = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
ReDim resArr(1 To UBound(myArray), 1 To 3)

For i = 1 To UBound(myArray, 1)
    x = Split(myArray(i, 1), ",")
    For j = LBound(x) To UBound(x)
        If InStr(1, x(j), "VT1") > 0 Then
            resArr(i, 1) = Trim(Replace(x(j), "VT1-", ""))
        ElseIf InStr(1, x(j), "VT2") > 0 Then
            resArr(i, 2) = Trim(Replace(x(j), "VT2-", ""))
        ElseIf InStr(1, x(j), "VT3") > 0 Then
            resArr(i, 3) = Trim(Replace(x(j), "VT3-", ""))
        Else
            resArr(i, 3) = "Check DATA, likely error in source string"
        End If
    Next j
Next

Range("B2").Resize(UBound(resArr, 1), 3) = resArr
    

End Sub

Originally Posted by CK76

Try below code then. It will put Error message in VT3 column.

Thanks for the help again. New code works great!

Originally Posted by CK76

Try below code then. It will put Error message in VT3 column.

Hi Again CK76,
Hate to bother you. But, I got a new set of data an was wondering if you could make one more tweak to your code. Attached is a new example of what I am working with. The VT columns already have a values in them. I would like the code the leave what is already in the cell if it is not being replaced. Your help is greatly appreciated.
Thanks again!

It's bit unclear what's needed.

Let me see if I understood it right.

If any value is already present in B:D range (other than 0 or blank) then update value. Otherwise leave it alone?

Or do you want to keep 0 as well?

Originally Posted by ck76

it's bit unclear what's needed.

Let me see if i understood it right.

If any value is already present in b:d range (other than 0 or blank) then update value. Otherwise leave it alone?

Or do you want to keep 0 as well?

Hi CK76,
Sorry for not being more clear. But, your assumption is correct. I want to leave whatever is in the b:d range unless it gets replaced by what is in the DATA column. Hope this helps.
Thanks

BEFORE RUNNING CODE

data	vt1	vt2	vt3
vt2-2.467, vt3-5.002	1.2	0	0
vt3-4	2.2	0	0

AFTER RUNNING CODE

data	vt1	vt2	vt3
vt2-2.467, vt3-5.002	1.2	2.467	5.002
vt3-4	2.2	0	4

Originally Posted by CK76

Edit: Code removed as I found error. Will get back once it's been fixed.

This ought to do it.

Hi CK76,
The updated code is working great. Thanks for taking all this time to help me out.
Thanks again!

Originally Posted by CK76

Edit: Code removed as I found error. Will get back once it's been fixed.

This ought to do it.

Sub SplitData()
Dim resArr, x
Dim i As Integer, j As Integer
myArray = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
ReDim resArr(1 To UBound(myArray), 1 To 3)

compArr = Range("B2:D" & UBound(myArray) + 1).Value

For i = 1 To UBound(myArray, 1)
    If InStr(1, myArray(i, 1), "VT1") Then
        resArr(i, 1) = Trim(Split(Split(myArray(i, 1), "VT1-")(1), ",")(0))
    Else
        resArr(i, 1) = compArr(i, 1)
    End If
    If InStr(1, myArray(i, 1), "VT2") Then
        resArr(i, 2) = Trim(Split(Split(myArray(i, 1), "VT2-")(1), ",")(0))
    Else
        resArr(i, 2) = compArr(i, 2)
    End If
    If InStr(1, myArray(i, 1), "VT3") Then
        resArr(i, 3) = Trim(Split(Split(myArray(i, 1), "VT3-")(1), ",")(0))
    Else
        resArr(i, 3) = compArr(i, 3)
    End If
Next

Range("B2").Resize(UBound(resArr, 1), 3) = resArr
    
End Sub

Hi All,
I use this code from CK76 all the time and it has worked perfectly for years. Recently the way I receive the data has changed. I was hoping that CK76 or someone could help update the code to adjust for the change. Attached is a spreadsheet with an example of the update. Any help greatly appreciated.
Thanks

Originally Posted by AlKey

It looks like the data is now more organized on you last upload than the original spreadsheet you provided.
Enter in B2 and copy across and down

Formula:

=IFERROR(ABS(LOOKUP(10^308,-LEFT(TRIM(MID(SUBSTITUTE($A2,B$1,REPT(" ",99)),99,99)),ROW(B$1:B$15)))),"")

Please see attached file

Hi Alkey,
Thanks for the for the help. Your formula is another great option to complete my task.
Thanks for your time.

You are welcome