Can someone help me with VBA code to split cell info into new row

[Liverlee]

Hi. I have a range of cells from $A2 to $E2. In B2 users there's text seperated by a comma. In the second sheet i'd like to see B2 info split into new row.

test 1	area 1	10​	grade 1	1 hours
test 1	area 2	10​	grade 1	1 hours
Test 2	area 3	10​	grade 1	10 hours
Test 2	area 1	10​	grade 1	10 hours

Not getting that, with the following code it seems to keep splitting b2 into new rows in second sheet.

Sub UpdateDataSheet()
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lastRow As Long
Dim sourceRange As Range
Dim cell As Range
Dim splitValues() As String
Dim newRow As Long

' Set the source and destination worksheets
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsDest = ThisWorkbook.Worksheets("Split")

' Find the last row in the source sheet
lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

' Set the source range to columns A to E from row 2 to the last row
Set sourceRange = wsData.Range("A2:E" & lastRow)

' Clear the existing data in destination sheet
wsDest.Range("A2:E" & wsDest.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents

' Loop through each cell in the source range
For Each cell In sourceRange
' Split the values in column B by comma
splitValues = Split(cell.Offset(0, 1).Value, ",")

' Get the corresponding values from columns A, C, D, and E
Dim valueA As String
Dim valueC As String
Dim valueD As String
Dim valueE As String
valueA = cell.Value
valueC = cell.Offset(0, 2).Value
valueD = cell.Offset(0, 3).Value
valueE = cell.Offset(0, 4).Value

' Determine the starting row for the new split values in the destination sheet
newRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1

' Copy the split values to new rows in the destination sheet
For i = LBound(splitValues) To UBound(splitValues)
wsDest.Cells(newRow, "A").Value = valueA
wsDest.Cells(newRow, "B").Value = Trim(splitValues(i))
wsDest.Cells(newRow, "C").Value = valueC
wsDest.Cells(newRow, "D").Value = valueD
wsDest.Cells(newRow, "E").Value = valueE
newRow = newRow + 1
Next i
Next cell
End Sub

Where am I going wrong? can someone please explain it to me?

 

[Liverlee]

Sub UpdateDataSheet()
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lastRow As Long
Dim sourceRange As Range
Dim cell As Range
Dim splitValues() As String
Dim newRow As Long

' Set the source and destination worksheets
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsDest = ThisWorkbook.Worksheets("Split")

' Find the last row in the source sheet
lastRow = wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Row

' Set the source range to column B from row 2 to the last row
Set sourceRange = wsData.Range("B2:B" & lastRow)

' Clear the existing data in destination sheet
wsDest.Range("A2:E" & wsDest.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents

' Loop through each cell in the source range
For Each cell In sourceRange
' Split the values by comma
splitValues = Split(cell.Value, ",")

' Get the corresponding values from columns A, C, D, and E
Think I've sorted myself out


Dim valueA As String
Dim valueC As String
Dim valueD As String
Dim valueE As String
valueA = wsData.Cells(cell.Row, "A").Value
valueC = wsData.Cells(cell.Row, "C").Value
valueD = wsData.Cells(cell.Row, "D").Value
valueE = wsData.Cells(cell.Row, "E").Value

' Determine the starting row for the new split values in the destination sheet
newRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1

' Copy each split value to a new row in the destination sheet
For i = LBound(splitValues) To UBound(splitValues)
wsDest.Cells(newRow, "A").Value = valueA
wsDest.Cells(newRow, "B").Value = Trim(splitValues(i))
wsDest.Cells(newRow, "C").Value = valueC
wsDest.Cells(newRow, "D").Value = valueD
wsDest.Cells(newRow, "E").Value = valueE
newRow = newRow + 1
Next i
Next cell
End Sub

 

[Liverlee]

actually now i've converted the info in 'split sheet' into a table and it's messed it all up again, can anyone help, pleasssssssssssssssse?

 

[Killragtshirts]

Hi,

I think I understand what your trying to do.

It's similar to this however you want the output on another sheet.

Text to Rows VBA Excel

I have a spreadsheet with about a good 4000 rows of data, one of the columns of data has unique order numbers that I want separated using "/" as my delimiter. So essentially I want: Name Orde...

stackoverflow.com

Your getting this output because your looping from a cell perspective and you don't need to.

If you wanted to continue your code you would need to get each row first and then get the cells in each row.

A more simpler approach would be to just copy the rows and overwrite the B2 and B3 on the new sheet with the split values for the first line in the data sheet and then do the same for next line.

There's probably a number of different ways to resolve this TBH.

If your super stuck ill get something to you soon. Thanks

 

[Liverlee]

If it can be done without VBA show me the way as I'm not confident with VBA at all

 

[Killragtshirts]

This should work (Its not pretty). If your destination sheet does not have a heading change Y = 2 to Y = 1. You will also need to make sure the data Tab is selected before you run it. Im sure someone will post something better however, I have to go unfortunately.

Sub UpdateDataSheet()
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lastRow As Long
Dim sourceRange As Range
Dim cell As Range
Dim splitValues() As String
Dim newRow As Long
Dim Y As Integer

' Set the source and destination worksheets
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsDest = ThisWorkbook.Worksheets("Split")

' Clear the existing data in destination sheet
wsDest.Range("A2:E" & wsDest.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents

'New Code
Dim i As Long, c As Long, r As Range, v As Variant

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
    v = Split(Range("B" & i), ",")
    c = c + UBound(v) + 1
Next i

Y = 2

For i = 2 To c
    Set r = Range("B" & i)
    Dim arr As Variant
    arr = Split(r, ",")
    Dim j As Long
    For j = 0 To UBound(arr)
   
        wsDest.Cells(Y, "A").Value = r.Offset(0, -1)
        wsDest.Cells(Y, "B").Value = Trim(arr(j))
        wsDest.Cells(Y, "C").Value = r.Offset(0, 1)
        wsDest.Cells(Y, "D").Value = r.Offset(0, 2)
        wsDest.Cells(Y, "E").Value = r.Offset(0, 3)
       
        Y = Y + 1
     
    Next j
Next i

End Sub

 

[Liverlee]

Thank you that works perfectly in terms of splitting the cells.