View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default I want to separate text at all the full stops

On Thu, 15 Jan 2009 13:21:27 -0500, Ron Rosenfeld
wrote:

On Thu, 15 Jan 2009 16:10:09 -0000, "Michelle"
wrote:

I know I can do this with text-to-columns, but I may have more than 256
strings in my text-file seperated by full stops, and I can't always use
2007.

What I need is a kind of 'Text-to-Rows' feature, so that it puts each string
into the next cell down

Is there an easy way to do this?

M


This does literally what you request:

=================================
Option Explicit
Sub TextToRows()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[^.]+"

For Each c In Selection 'or however you set up
'the range to process

If re.test(c.Value) = True Then
i = 2
Set mc = re.Execute(c.Value)
For Each m In mc
c(i, 1).Value = m.Value
i = i + 1
Next m
End If
Next c
End Sub
==================================

This is a little cleaner as it strips off the leading <space's that may be
between the "." and the next word:

================================
Option Explicit
Sub TextToRows()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[^.]+"

For Each c In Selection 'or however you set up
'the range to process

If re.test(c.Value) = True Then
i = 2
Set mc = re.Execute(c.Value)
For Each m In mc
c(i, 1).Value = Trim(m.Value)
i = i + 1
Next m
End If
Next c
End Sub
===============================
--ron


One other variation, if you prefer, retains the trailing "." at the end of the
sentences. (The Text to columns, using "." as a delimiter, would not, so I did
not do that initially). This also will not return any <space's at the start
of the string (equivalent to the TRIM function in the above).

=========================================
Option Explicit
Sub TextToRows()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[^.\s][^.]+\."

For Each c In Selection 'or however you set up
'the range to process

If re.test(c.Value) = True Then
i = 2
Set mc = re.Execute(c.Value)
For Each m In mc
c(i, 1).Value = m.Value
i = i + 1
Next m
End If
Next c
End Sub
===========================================
--ron