View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Dan E[_2_] Dan E[_2_] is offline
external usenet poster
 
Posts: 102
Default extracting text from within a cell - 'text to rows@ equivalent of 'text to columns'

Here's a couple of functions, TextToRows and TextToCols,

Sub TextToRows()
Sep = InputBox("Enter the S & the separator type or Q & the qualifier type " & vbCrLf _
& "(ie S, for comma separated or Q' for single quote qualified)", "Separator")
If Sep = "" Then Exit Sub
If Left(Sep, 1) = "S" Then
Sep = Mid(Sep, 2, 1)
DoWhat = 1
ElseIf Left(Sep, 1) = "Q" Then
Sep = Mid(Sep, 2, 1)
DoWhat = 2
Else
MsgBox Prompt:="Invalid Entry"
Exit Sub
End If

If DoWhat = 1 Then
For Each Cell In Selection
WholeLine = CStr(Cell.Value)
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
RowNum = 0
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cell.Offset(RowNum, 0).Value = TempVal
Pos = NextPos + 1
RowNum = RowNum + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
Next
Else
For Each Cell In Selection
WholeLine = CStr(Cell.Value)
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
RowNum = 0
Q1 = 1
Q2 = InStr(2, WholeLine, Sep)
While Q1 = 1
TempVal = Mid(WholeLine, Q1 + 1, Q2 - Q1 - 1)
Q1 = InStr(Q2 + 1, WholeLine, Sep)
Q2 = InStr(Q1 + 1, WholeLine, Sep)
Cell.Offset(RowNum, 0).Value = TempVal
RowNum = RowNum + 1
Wend
Next
End If
End Sub

Sub TextToCols()
Sep = InputBox("Enter the S & the separator type or Q & the qualifier type " & vbCrLf _
& "(ie S, for comma separated or Q' for single quote qualified)", "Separator")
If Sep = "" Then Exit Sub
If Left(Sep, 1) = "S" Then
Sep = Mid(Sep, 2, 1)
DoWhat = 1
ElseIf Left(Sep, 1) = "Q" Then
Sep = Mid(Sep, 2, 1)
DoWhat = 2
Else
MsgBox Prompt:="Invalid Entry"
Exit Sub
End If

If DoWhat = 1 Then
For Each Cell In Selection
WholeLine = CStr(Cell.Value)
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
ColNum = 0
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cell.Offset(0, ColNum).Value = TempVal
Pos = NextPos + 1
ColNum = ColNum + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
Next
Else
For Each Cell In Selection
WholeLine = CStr(Cell.Value)
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
ColNum = 0
Q1 = 1
Q2 = InStr(2, WholeLine, Sep)
While Q1 = 1
TempVal = Mid(WholeLine, Q1 + 1, Q2 - Q1 - 1)
Q1 = InStr(Q2 + 1, WholeLine, Sep)
Q2 = InStr(Q1 + 1, WholeLine, Sep)
Cell.Offset(0, ColNum).Value = TempVal
ColNum = ColNum + 1
Wend
Next
End If
End Sub

If the data is contained in "" it completely ignores the ,'s and separates based on the "'s

Dan E

"peter smith" wrote in message om...
thanks v much for the response Dan E.
do you know how I could build in a 'text qualifier' option, again
equivalent to the functionality of the 'text to columns' feature.
basically I need to separate by commas EXCEPT where the comma is
WITHIN a text string. as i have exported this data from a word form
all the text is contained within " ".
maybe this is getting too complicated.
thanks again for any help/suggestions.
Peter






"Dan E" wrote in message ...
OOPS

Shoulda called it TextToRows?? Oh well . . .

Dan E

"Dan E" wrote in message
...
I believe this will do what you ask

Sub TextToColumns()
Sep = InputBox("Enter the separator type", "Separator")
If Sep = "" Then Exit Sub
For Each Cell In Selection
WholeLine = CStr(Cell.Value)
If Right(WholeLine, 1) < Sep Then
WholeLine = WholeLine & Sep
End If
RowNum = 0
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos = 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cell.Offset(RowNum, 0).Value = TempVal
Pos = NextPos + 1
RowNum = RowNum + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
Next
End Sub

Dan E

"peter smith" wrote in message
om...
I'm trying to work out how to extract text strings of varying length
from within a cell. The text instances I need to extract are all
between " ".
I then need to paste each piece of extracted text into cells a2, a3
,a4 etc.
I was planning to use 'text to columns' to spearate out the text but
am limited by the maximum number of columns (256).
Essentially what I need is something to provide the functionality of
'text to rows'.

e.g. In cell a1 I have the follwoing text:
"a","b","dog"

and what I need to do is enter "a" in cell a2, "b" in cell a3 and
"dog" in cell a4. Given that my actual data will covers more than 256
cells I can't just use text to columns, then transpose the data.

Any help greatly appreciated.
Peter