I want to separate text at all the full stops

M

Michelle

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
 
J

JE McGimpsey

One way:

Public Sub FullStopDelmitedTextToRows()
Const csDelim As String = "."
Dim vArr As Variant
Dim rCell As Range
With Selection
If .Rows.Count > 1 Then
MsgBox "You must choose cells in one row only"
Else
For Each rCell In .Cells
With rCell
If Not IsEmpty(.Value) Then
vArr = Split(.Text, csDelim)
If IsArray(vArr) Then
With .Resize(UBound(vArr) - LBound(vArr) + 1, 1)
If Application.CountA(.Cells) > 1 Then
MsgBox "Can only expand into empty cells"
Exit Sub
End If
.Value = Application.Transpose(vArr)
End With
Else
.Value = vArr
End If
End If
End With
Next rCell
End If
End With
End Sub

Note: Error checking is very minimal
 
R

Ron Rosenfeld

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
Click to expand...

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
 
R

Ron Rosenfeld

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
Click to expand...

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
Click to expand...

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
 
R

Ron Rosenfeld

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
Click to expand...

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
Click to expand...

And one final variation returns the trailing string even if it does not end
with a "."

By the way, the differences are in re.Pattern

========================================
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

How to center adjust text above and image in a two column document. 1
Cell data entering slow! 0
Extract Text in braquet and list of terms from 2 Docs 3
Creating Labels Over 3-Up Image 2
Excel 2013 Merge Data 2
Text To Columns then insert rows 7
Problem with exported text 8
VBA Read-Manipulate-Save Text File 5

Top