CODEWITHSUNDEEP
excelvbasplit
user51443020497
user51443020497

Reputation: 1

Split text in cells from multiple columns in a range of rows into several lines

There is a table with each row needs to be separated so as there is only one name/date/transfer method in a cell in each row. I was able to separate it by names but I struggle to get the dates and e-mail-thing right, because sometimes the cells in respective columns are empty:

Input table

Desired result

I did this for names:

Sub splitcells()

Dim splitVals As Variant

Dim totalVals As Long

Set sh1 = ThisWorkbook.Sheets(1)

Set sh2 = ThisWorkbook.Sheets(2)

lrow1 = sh1.Range("A65356").End(xlUp).Row

For j = 2 To lrow1

splitVals = split(sh1.Cells(j, 2), Chr(10))

For i = LBound(splitVals) To UBound(splitVals)

lrow2 = sh2.Range("B65356").End(xlUp).Row

lrow3 = sh2.Range("A65356").End(xlUp).Row

sh2.Cells(lrow3 + 1, 1) = sh1.Cells(j, 1)

sh2.Cells(lrow3 + 1, 2) = splitVals(i)

Next i

Next j

End SubI tried to do the same thing for the rest by moving all the column indicators to column 3 like below, but it doesn`t work properly, filling dates in every cell in a column while some of them should be empty:

Sub splitcells2()

Dim splitVals As Variant

Dim totalVals As Long

Set sh1 = ThisWorkbook.Sheets(1)

Set sh3 = ThisWorkbook.Sheets(3)

lrow1 = sh1.Range("A65356").End(xlUp).Row

For j = 2 To lrow1

splitVals = split(sh1.Cells(j, 3), Chr(10))

For i = LBound(splitVals) To UBound(splitVals)

lrow2 = sh3.Range("B65356").End(xlUp).Row

lrow3 = sh3.Range("A65356").End(xlUp).Row

sh3.Cells(lrow3 + 1, 1) = sh1.Cells(j, 1)

sh3.Cells(lrow3 + 1, 2) = splitVals(i)

Next i

Next j

End Sub

Upvotes: 0

Views: 168

Answers (1)

karma
karma

Reputation: 2009

If I understand you correctly, maybe something like this ?

Sub test()
Dim splitVals As Variant

Set sh1 = ThisWorkbook.Sheets(1)
Set sh2 = ThisWorkbook.Sheets(2)
colcount = 6 'change if not the same with the actual table
lrow1 = sh1.Range("A65356").End(xlUp).Row


For j = 2 To lrow1

    Set oFill = sh2.Range("A65356").End(xlUp).Offset(1, 0)
    With sh1.Cells(j, 2)
        If InStr(.Value, Chr(10)) Then
            cnt = Len(.Text) - Len(Replace(.Text, Chr(10), "")) + 1
            Set oFill = oFill.Resize(cnt, 1)
        End If
    End With
    
        For i = 1 To colcount
            With sh1.Cells(j, i)
                If InStr(.Value, Chr(10)) Then
                    splitVals = Application.Transpose(Split(.Value, Chr(10)))
                Else
                    splitVals = .Value
                End If
            End With
            oFill.Offset(0, i - 1).Value = splitVals
        Next i
        
Next j

End Sub

The code has two loop. The first, loop to each row in column A, the second, loop to each column of the table.

At the first loop, it check if the looped cell offset(j,2) has a line break then it set the oFill (the target cell to be filled) to resize as much as the rows needed.

At the second loop, it check if the looped cell has a line break then it get the value of the looped cell with split function as splitVals variable. If no line break, the splitVals value is the same with the looped cell. Then finally it put the splitVals to the oFill range. Do the same with the rest of the column.

Please be noticed, the code assumes that if in column B there are N names, then the rest of the column (same row) value is either with N lines or blank.

After from VBasic2008 help to my code, please change this line: lrow1 = sh1.Range("A65356").End(xlUp).Row
Set oFill = sh2.Range("A65356").End(xlUp).Offset(1, 0)
into something like this :
lrow1 = sh1.Range("A" & rows.count).End(xlUp).Row
Set oFill = sh2.Range("A" & rows.count).End(xlUp).Offset(1, 0)

Upvotes: 1

Related Questions