Manipulating this text.

[StargateFanFromWork]

This one is not for work, for once, but I'm hoping someone will like to help
with this fun thing. I'd like to create a means to make part of the process
of creating word puzzles called syllacrostics automated. Since it's
something I hope to do on at least a weekly basis, it would be easiest to do
this in Excel because I need all the boxes (the cells and rows) and
automating it will allow me to concentrate on the puzzle itself rather than
in the creation of the word puzzle.

Here's what's needed after pasting a text string into A1:
1. Remove the spaces between the words.
2. Take that text string and cut it in half into 2 sentences.
3. Re-arrange the 2 "sentences" so that the letters are no longer
horizontal but vertical and, therefore, become vertical sentences in two
columns.
Separate the 2 setences-turned-into-columns by one empty column (width
unimportant at this point, though about 20 pixels great).

To demonstrate, a text string is copied into A1. In this example, I'll use:

"Fill in the answers to the clues by selecting the correct syllables from
the list below"



Step 1: spacing between words removed:
"Fillintheanswerstothecluesbyselectingthecorrectsyllablesfromthelistbelow"



Step 2: string cut in half (quotation marks so it's easier to see from this
point on):



Fillintheanswerstothecluesbyselectin

gthecorrectsyllablesfromthelistbelow



Step 3: the two sentences converted into two columns (there can only be 2
columns, that's why text string cut

in _half_) with an extra column in between:



F g
i t
l h
l e
i c
n o
t r
h r
e e
a c
n t
s s
w y
e l
r l
s a
t b
o l
t e
h s
e f
c r
l o
u m
e t
s h
b e
y l
s i
e s
l t
e b
c e
t l
i o
n w



Can this be done in Excel? I would prefer it as I am more comfortable
working in Excel's vbe for anything later that needs adding, that in Word.
Also, the results would come out in table format, which is what I need.









[I do have code for putting each letter into its own cell at some point,
though don't know if it can be used here. It was kindly given to me a few
weeks back:



Sub a_SelectText_ConvertsTextToOneCellPerLetter()
'
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1), Array(3, 1),
Array(4, 1), Array _
(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1),
Array(10, 1), Array(11, 1), Array _
(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1),
Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23,
1), Array(24, 1), Array( _
25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1),
Array(30, 1), Array(31, 1), _
Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36,
1), Array(37, 1), Array( _
38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1),
Array(43, 1), Array(44, 1), _
Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49,
1), Array(50, 1), Array( _
51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1),
Array(56, 1), Array(57, 1), _
Array(58, 1), Array(59, 1), Array(60, 1), Array(61, 1), Array(62,
1), Array(63, 1), Array( _
64, 1))
End Sub

]



Thanks and cheers! D



p.s., some syllacrostic examples:

http://www.pennypress.com/samplepuzzles/srwoo15.pdf

http://www.puzzlechoice.com/pc/Syllax.html

http://www.aviewofamerica.com/Puzzles/Syllacrostic/syllacrostic.htm

 

[Ron Rosenfeld]

Here's what's needed after pasting a text string into A1:
1. Remove the spaces between the words.
2. Take that text string and cut it in half into 2 sentences.
3. Re-arrange the 2 "sentences" so that the letters are no longer
horizontal but vertical and, therefore, become vertical sentences in two
columns.
Separate the 2 setences-turned-into-columns by one empty column (width
unimportant at this point, though about 20 pixels great).

This code might do what you describe:

==========================================
Option Explicit

Sub Syll()
Dim c As Range
Dim str As String
Dim i As Long

Set c = Selection

str = c.Text
str = Replace(str, " ", "")

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
=================================================
--ron

 

[StargateFanFromWork]

This code might do what you describe:

It sure does. It does exactly what's needed.

I ran into a hitch with punctuation. Probably would be easier to have XL2K
remove it ... (cont'd below****)

==========================================
Option Explicit

Sub Syll()
Dim c As Range
Dim str As String
Dim i As Long

Set c = Selection

str = c.Text
str = Replace(str, " ", "")

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
=================================================
--ron

**** ... so I've been playing around with the code. I found help again in
the archives but I'm lucky in one aspect. There happened to be a number in
the nonsense text string I used as a test. I recently learned how to search
and replace a lot of things in Word VBA so tried to apply a bit of that
knowledge to the macro. Here's what I came up with. I don't pretend that
it's the best way to go about removing punctuation but thought I'd take a
stab at it. Everything works except for the wildcards to get rid of any
number that might be in the string:






************************************************************************************
Option Explicit

Sub Syllacrostic()

Cells.Replace What:="~?", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~.", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~,", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~:", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~;", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~""", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="[0-9]", Replacement:=" ", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False
' Find all the extra spaces and make down to just 1 space
Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False

Dim c As Range
Dim str As String
Dim i As Long

Set c = Selection

str = c.Text
str = Replace(str, " ", "")

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
************************************************************************************



What do you think? How can XL2K get rid of any numbers before preparing to
go on to the next step?

Thanks! This is great. D

 

[Ron Rosenfeld]

This code might do what you describe:

It sure does. It does exactly what's needed.

I ran into a hitch with punctuation. Probably would be easier to have XL2K
remove it ... (cont'd below****)

==========================================
Option Explicit

Sub Syll()
Dim c As Range
Dim str As String
Dim i As Long

Set c = Selection

str = c.Text
str = Replace(str, " ", "")

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
=================================================
--ron

**** ... so I've been playing around with the code. I found help again in
the archives but I'm lucky in one aspect. There happened to be a number in
the nonsense text string I used as a test. I recently learned how to search
and replace a lot of things in Word VBA so tried to apply a bit of that
knowledge to the macro. Here's what I came up with. I don't pretend that
it's the best way to go about removing punctuation but thought I'd take a
stab at it. Everything works except for the wildcards to get rid of any
number that might be in the string:






************************************************************************************
Option Explicit

Sub Syllacrostic()

Cells.Replace What:="~?", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~.", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~,", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~:", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~;", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="~""", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:="[0-9]", Replacement:=" ", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False
' Find all the extra spaces and make down to just 1 space
Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False

Dim c As Range
Dim str As String
Dim i As Long

Set c = Selection

str = c.Text
str = Replace(str, " ", "")

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
************************************************************************************



What do you think? How can XL2K get rid of any numbers before preparing to
go on to the next step?

Thanks! This is great. D

If I understand you correctly, what you want to do is retain only the letters,
both capital and small, and get rid of everything else -- spaces, punctuation,
numbers.

I would do that using a simple regular expression routine to replace anything
that is not a letter.

Try this:

=============================================
Option Explicit

Sub Syll()
Dim c As Range
Dim str As String
Dim i As Long
Dim oRegex As Object

Set oRegex = CreateObject("VBScript.RegExp")

Set c = Selection

With oRegex
.ignorecase = True
.Global = True
.Pattern = "[^a-z]"
str = oRegex.Replace(c.Text, "")
End With

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
=========================================
--ron

 

[StargateFanFromWork]

[snip]

If I understand you correctly, what you want to do is retain only the
letters,
both capital and small, and get rid of everything else -- spaces,
punctuation,
numbers.

I would do that using a simple regular expression routine to replace
anything
that is not a letter.

Try this:

=============================================
Option Explicit

Sub Syll()
Dim c As Range
Dim str As String
Dim i As Long
Dim oRegex As Object

Set oRegex = CreateObject("VBScript.RegExp")

Set c = Selection

With oRegex
.ignorecase = True
.Global = True
.Pattern = "[^a-z]"
str = oRegex.Replace(c.Text, "")
End With

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
=========================================

<g> Much, much better than mine, Ron! I've had time to think about this
since I posted and I've figured out that I will not be able to use anything
with nunbers in it anyway. But this here is perfect. I'll be able to start
create Syllacrostics now. Totally awesome. And the time saved is
incredible.

Thanks!

 

[Ron Rosenfeld]

[snip]

If I understand you correctly, what you want to do is retain only the
letters,
both capital and small, and get rid of everything else -- spaces,
punctuation,
numbers.

I would do that using a simple regular expression routine to replace
anything
that is not a letter.

Try this:

=============================================
Option Explicit

Sub Syll()
Dim c As Range
Dim str As String
Dim i As Long
Dim oRegex As Object

Set oRegex = CreateObject("VBScript.RegExp")

Set c = Selection

With oRegex
.ignorecase = True
.Global = True
.Pattern = "[^a-z]"
str = oRegex.Replace(c.Text, "")
End With

For i = 1 To Int(Len(str) / 2)
c.Offset(i, 0).Value = Mid(str, i, 1)
Next i

For i = i To Len(str)
c.Offset(i - Int(Len(str) / 2), 2).Value = Mid(str, i, 1)
Next i

End Sub
=========================================

<g> Much, much better than mine, Ron! I've had time to think about this
since I posted and I've figured out that I will not be able to use anything
with nunbers in it anyway. But this here is perfect. I'll be able to start
create Syllacrostics now. Totally awesome. And the time saved is
incredible.

Thanks!

You're welcome. Glad to help. Thanks for the feedback.
--ron