Extracting Text from a text string

[Guest]

I have the text results of a survey in just one cell stored as text, I would
like to generate the required number of columns as per the answers given, for
example :
In Cell J1 I have :

Easier:no,Faster:no,More Plaisant:no,The original system with the white
boards was easier; faster; and anybody could look at them and tell what was
going on.

I would like to extract the information and generate the columns K (Easier),
L (Faster), M (More Plaisant), N (comments)
with the answers on each column (no, no, no, "The original ...), what should
be the code ?

Thanks in advance

 

[Guest]

Sub exttractdata()

Const EASIER = "EASIER"
Const FASTER = "FASTER"
Const PLAISANT = "MORE PLAISANT"


DataString = Cells(1, "J")
RowCount = 1
For i = 1 To 3

Verb = UCase(Left(DataString, InStr(DataString, ":") - 1))
DataString = Mid(DataString, InStr(DataString, ":") + 1)
Truth = UCase(Left(DataString, InStr(DataString, ",") - 1))
DataString = Mid(DataString, InStr(DataString, ",") + 1)

Select Case Verb

Case EASIER
Cells(RowCount, "K") = Truth
Case FASTER
Cells(RowCount, "L") = Truth
Case PLAISANT
Cells(RowCount, "M") = Truth
End Select
Next i

Cells(RowCount, "N") = DataString

End Sub

 

[Dave Peterson]

You could use a UDF:

Option Explicit
Function mySplit(myStr As String) As Variant

Dim myKeys As Variant
Dim myPos() As Long
Dim myArr() As String
Dim cCtr As Long
Dim iCtr As Long
Dim myTemp As String

myKeys = Array("Easier:", "Faster:", "More Plaisant:")

ReDim myPos(LBound(myKeys) To UBound(myKeys) + 1)
ReDim myArr(LBound(myKeys) To UBound(myKeys) + 1)

For iCtr = LBound(myKeys) To UBound(myKeys)
myPos(iCtr) = InStr(1, myStr, myKeys(iCtr), vbTextCompare)
Next iCtr

For iCtr = LBound(myKeys) To UBound(myKeys)
myTemp = ""
If myPos(iCtr) = 0 Then
'not found
Else
cCtr = myPos(iCtr) + Len(myKeys(iCtr))
Do
If Mid(myStr, cCtr, 1) = "," Then
Exit Do
End If
myTemp = myTemp & Mid(myStr, cCtr, 1)
cCtr = cCtr + 1
Loop
End If
myArr(iCtr) = Trim(myTemp)
Next iCtr
myArr(UBound(myArr)) = Mid(myStr, cCtr + 1)

mySplit = myArr

End Function

But this actually returns an array of values.

With the data in A1 (say)
Select K1:N1 and type this:
=mysplit(A1)
But instead of hitting enter, hit ctrl-enter

ps. I'm not sure this is a problem, but in American English, the phrase would
be spelled: More Pleasant:

But you'll want to make sure that the code actually matches what's in the data.

 

[Guest]

Joel,
Many thanks!
--
Moises

Sub exttractdata()

Const EASIER = "EASIER"
Const FASTER = "FASTER"
Const PLAISANT = "MORE PLAISANT"


DataString = Cells(1, "J")
RowCount = 1
For i = 1 To 3

Verb = UCase(Left(DataString, InStr(DataString, ":") - 1))
DataString = Mid(DataString, InStr(DataString, ":") + 1)
Truth = UCase(Left(DataString, InStr(DataString, ",") - 1))
DataString = Mid(DataString, InStr(DataString, ",") + 1)

Select Case Verb

Case EASIER
Cells(RowCount, "K") = Truth
Case FASTER
Cells(RowCount, "L") = Truth
Case PLAISANT
Cells(RowCount, "M") = Truth
End Select
Next i

Cells(RowCount, "N") = DataString

End Sub

 

[Guest]

Dave,
When I select K1:N1 and type =mysplit(J1) (my data is in J1), I just receive
in K1 a text, and the other cells are empty (L,M,N), and on those cells a
formula =mysplit() with , K1, L1, & M1 appear.

 

[Dave Peterson]

I had a typo in my instructions.

Instead of hitting enter, hit ctrl-shift-enter (not ctrl-enter, sorry).

This is an array formula. Hit ctrl-shift-enter instead of enter. If you do it
correctly, excel will wrap curly brackets {} around your formula. (don't type
them yourself.)

Dave,
When I select K1:N1 and type =mysplit(J1) (my data is in J1), I just receive
in K1 a text, and the other cells are empty (L,M,N), and on those cells a
formula =mysplit() with , K1, L1, & M1 appear.

 

[Guest]

Dave,
Thanks, very good.
--
Moises

I had a typo in my instructions.

Instead of hitting enter, hit ctrl-shift-enter (not ctrl-enter, sorry).

This is an array formula. Hit ctrl-shift-enter instead of enter. If you do it
correctly, excel will wrap curly brackets {} around your formula. (don't type
them yourself.)