Seperate the multiple data from one cell in different rows

[deven_deesha]

Hi,

I have a data in one cell seperated by Space (Alt + Enter) like

Suit/ADR



Suit/ADR



Suit/ADR



Suit/ADR



Suit/ADR



Suit/ADR


I want to create that many rows. i. copy Suit/ADR in one row.
next in second row. like that I have to continue.

Can you please help me how to proceed on the same?

Appreciate your help

Thanks
Shriswaroop

 

[ctrlaltdel]

This isn't the best solution but

When I'm faced with this, I copy the cell or cells from excel into word. I then copy them back into excel and voila!

Of course you are then faced with removing the blank rows, but that can be done using a sort in excel if necessary. Or if you really want to get tricky try using find/replace on "^l" in word before copying back.

Convoluted I know, but since you've not yet gotten an answer...

 

[deven_deesha]

Thanks ctrlaltdel.

But it won't work for me. I have a huge data and multiple columns with such data. I need to copy the value from each cell in different row. I tried the below macro

Sub Extract()

Dim row_count As Long
Dim values As String


Windows("01122007-VP3TestCoverage.csv").Activate
row_count = 2
While Range("C" & CStr(row_count)).Value <> vbEmpty
Windows("01122007-VP3TestCoverage.csv").Activate
values = Range("C" & CStr(row_count)).Value
While Len(values) > 0 'test for multiple KRT IDs
values = add_KRTID(values, row_count)
Wend
row_count = row_count + 1
Wend

End Sub


Private Function add_Additional(kValue, row_count)

Range("C" & CStr(row_count)).Select
Selection.Cells.EntireRow.Copy 'for copy and paste functionality
Windows("Test.xls").Activate
' Selection.Cells.EntireRow.Insert
If (Asc(kValue) <> 10) Then
Range("C" & CStr(row_count)).Value = kValue
row_count = row_count + 1
End If
Windows("01122007-VP3TestCoverage.csv").Activate
End Function

Private Function add_KRTID(values As String, row_count As Long)
'Dim pos, count As Integer
Dim KRT As String

pos = InStr(1, values, Chr(13), vbBinaryCompare)
If (pos = 0) Then
pos = InStr(1, values, ";", vbTextCompare)
End If

If (pos > 0) Then 'found another KRTID add row
KRT = Left(values, pos - 1)
values = Trim(Replace(values, values, Right(values, Len(values) - pos)))
Call add_Additional(KRT, row_count)
Else 'last KRT ID or one KRT ID
Range("A" & CStr(row_count)).Value = values
values = "" 'remove last KRT ID
End If
add_KRTID = values
End Function


But I have one problem i.e the data is seperated by Alt + Enter then I am not able to get that value. I tried to use ASC function some regular expression but it is giveing me an error.

Can you help me on this

Thanks
Shriswaroop

 

[ctrlaltdel]

did you even try my simple solution?

I can see your dilemma, but by pulling the data in and out of word, you do actually get rid of all the alt-enter soft returns. Perhaps you can figure out what that is doing and integrate it into your macro.

Sorry I can't be of more help, but I guess I'm at least bumping this so that those with true knowledge might look twice :wink:

 

[ya5irha55an]

Hi,

the function Clean will clear out any alt-enter's. if the data is in column a, just put in cell b1 clean(a1) and then copy the formula down.