Multiple lines of text in one cell need macro to format the data

Joined
May 24, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi there,

I have data in column A where there are multiple varying lines of text within each cell. In column B and C I have one line of text.
Using a macro I want to split all the data in Column A into one line of text equal to one line of text and align the corresponding value in column B and C to the row.

Using the below code I can take the values in Column A and split them into rows however I cant seem to add the original values in column B and C to this

VBA Code:
Sub Format_text()

Dim cell_value As Variant
Dim counter As Integer

'Row counter
counter = 1

'Looping trough A column define max value
For i = 1 To 500

    'Take cell at the time
    cell_value = ThisWorkbook.ActiveSheet.Cells(i, 1).Value

    'Split cell contents
    Dim WrdArray() As String
    WrdArray() = Split(cell_value, vbLf)

    'Place values to the B column
    For Each Item In WrdArray
        ThisWorkbook.ActiveSheet.Cells(counter, 2).Value = Item
        counter = counter + 1
    Next Item

Next i
End Sub

Sample of the data
Cat
Dog
ZxxxxxxFxxxxxx
xxxxxxRxxxxxxS
xxxxxxOxxxxxx
xxxxxxOxxxxxx 3
xxxxxx
Need this oneNeed this one too
Apple
Fruit
Berry
Ice Cream
Pear
Orange
Include MeInclude Me too
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

rlv01

Well-known Member
Joined
May 16, 2017
Messages
890
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Your description is confusing. Instead of saying "need this one", show an example. Use your "cat, dog, ..." data in cell A1 to show us exactly what you expect to be placed in column B & C.
 
Joined
May 24, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Your description is confusing. Instead of saying "need this one", show an example. Use your "cat, dog, ..." data in cell A1 to show us exactly what you expect to be placed in column B & C.
Hi,
Apologies if it was somewhat confusing. Below is what I would like the end data to look like; You can see from the above starting point - in Cell A1 there are multiple lines of text - I require this to split out into multiple cells and the corresponding value in B1 and C1 to be associated with the original values in Cell A1.

I hope that is more clear.

CatNeed this one tooNeed this one too
DogNeed this one tooNeed this one too
ZxxxxxxFxxxxxxNeed this one tooNeed this one too
xxxxxxRxxxxxxSNeed this one tooNeed this one too
xxxxxxOxxxxxxNeed this one tooNeed this one too
xxxxxxOxxxxxx 3Need this one tooNeed this one too
xxxxxxNeed this one tooNeed this one too
AppleInclude MeInclude Me too
FruitInclude MeInclude Me too
BerryInclude MeInclude Me too
Ice CreamInclude MeInclude Me too
PearInclude MeInclude Me too
OrangeInclude MeInclude Me too
 
Joined
May 24, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Using other values as requested...
CatValue 1Value 2
DogValue 1Value 2
ZxxxxxxFxxxxxxValue 1Value 2
xxxxxxRxxxxxxSValue 1Value 2
xxxxxxOxxxxxxValue 1Value 2
xxxxxxOxxxxxx 3Value 1Value 2
xxxxxxValue 1Value 2
AppleValue 3Value 4
FruitValue 3Value 4
BerryValue 3Value 4
Ice CreamValue 3Value 4
PearValue 3Value 4
OrangeValue 3Value 4
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,197
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

How about
VBA Code:
Sub cantrecall()
   Dim Ary As Variant, Nary As Variant, Sp As Variant
   Dim r As Long, nr As Long, i As Long
   
   Ary = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value2
   ReDim Nary(1 To Rows.Count - 2, 1 To 3)
   
   For r = 1 To UBound(Ary)
      Sp = Split(Ary(r, 1), vbLf)
      For i = 0 To UBound(Sp)
         nr = nr + 1
         Nary(nr, 1) = Sp(i)
         Nary(nr, 2) = Ary(r, 2)
         Nary(nr, 3) = Ary(r, 3)
      Next i
   Next r
   Range("E1").Resize(nr, 3).Value = Nary
End Sub
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
37,146
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
FWIW, since you have 365 you could do this with PowerQuery/Get and Transform.
 
Joined
May 24, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub cantrecall()
   Dim Ary As Variant, Nary As Variant, Sp As Variant
   Dim r As Long, nr As Long, i As Long
  
   Ary = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value2
   ReDim Nary(1 To Rows.Count - 2, 1 To 3)
  
   For r = 1 To UBound(Ary)
      Sp = Split(Ary(r, 1), vbLf)
      For i = 0 To UBound(Sp)
         nr = nr + 1
         Nary(nr, 1) = Sp(i)
         Nary(nr, 2) = Ary(r, 2)
         Nary(nr, 3) = Ary(r, 3)
      Next i
   Next r
   Range("E1").Resize(nr, 3).Value = Nary
End Sub
That works perfectly ;)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,197
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Forum statistics

Threads
1,136,909
Messages
5,678,522
Members
419,769
Latest member
Sparks66

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top