Solved: Put comma-delineated text in sep lines & export to Excel

[johnske]

Hi,

The person requiring this has a list of some 10,000 scrabble words that are arranged under bold headings. Each word is comma delineated.

The words need to be placed one on each line, the comma removed, and then exported to column B, Sheet1 of an Excel workbook. (one word per row - i.e. some 10,000 rows).

The end format needs to be something like this:
Your name (Col A)
Word Created (Col B)
Second Person (Col C)
Letter used from second Person (Col D)

A sample doc is attached

TIA,
John

[TonyJollans]

Hi John,

Can you expand on the requirements for columns A, C and D. How does Jodie AINOPST Michelle AEEGIOR

for example, become two names and a letter?

[johnske]

Hi John,

Can you expand on the requirements for columns A, C and D. How does Jodie AINOPST Michelle AEEGIOR

for example, become two names and a letter?

Hi Tony,

Not too sure of that myself :dunno I think that'd just be in the form of a sub-heading and she'd have to sort that out manually for herself. I just included it so you'd have all the info I have...

The main task she wanted was just to put each word in a cell in column B. (this is an updated requirement that wasn't given in the original rules)

Regards,
John :)

[johnske]

Hi Tony,

Am in contact on msn, here's reply...

Jodie white michelle te

so my name then word I created then otherpersons name and the letter I used from her seven to create it

[TonyJollans]

Sounds like fun. I'll do something (my) today but it will be a bit later on.

Just to confirm (my best guess) - we have a heading containing two names and two sets of scrabble letters, followed by several lists of words. These words are made from some combination of the fourteen letters and column D should contain those letters which are not in the first-named player's seven.

[johnske]

Yep, I think that's it Tony, thanx :friends: but she says she can do that bit manually if needs be, the important thing is for it just to be put in columns.

Regards,
John :thumb

[katt67]

Hi, I would like to start by thanking you guys for your help on this one, I am spinning with what you can do.
But I will try and explain as best I can...here goes

columns as follows:
Your name Word Created Second Person Letter used from second Person

titles as they are in doc are:
Jodie AINOPST Michelle AEEGIOR



so now I have to get doc to look like this:

Jodie Poster Michelle er ( I have used the ER from her letters to create word)

I hope I have explained that so you understand..if not thet most important thing I have to do is get all those words into the second column so I can hand do the rest.

Thank you heaps for wait ever you can do to help me out

[TonyJollans]

Hi katt67,

Welcome to the VBAX Scrabble corner!

I must admit to forgetting about this so, just before I go to bed, I have thrown this together - it appears to work on the example file - and doesn't (quite) take forever to run! It saves the workbook with the same name as the document - and in the same place.

The one problem I had was with separating the names and the trays of letters - I first assumed that the letters were all upper case but that's not always true. I will have to rethink the code for that bit.

At the moment I am assuming that letters in the words which are not in the first player's tray must be in the second player's tray - ought I to check that?

I will try and tidy it up tomorrow. Meanwhile ...

Sub scrabble()
' need to deal with bold/not and n-letter lits

' 1. Get rid of manual line breaks
With ActiveDocument.Content.Find
.Text = "^m"
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^l"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

Dim objPara As Paragraph
Dim sWord As Range
Dim sWorkWord As String

Dim vNames
Dim sPerson(1 To 2) As String
Dim sTray(1 To 2) As String
Dim sWorkTray As String
Dim sFromTray2 As String

Dim i As Integer, j As Integer

Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Dim objWorkbook As Object
Set objWorkbook = objExcel.Workbooks.Add
'objExcel.Visible = True
Dim objSheet As Object
Set objSheet = objWorkbook.worksheets(1)
Dim lRow As Long
lRow = 0

For Each objPara In ActiveDocument.Paragraphs

If objPara.Range.Words.Count = 1 Or Left(objPara.Range.Text, 16) = "TOTAL WORD COUNT" Then
' Empty Paragraph - Ignore
Else
If objPara.Range.Bold Then

If Trim(objPara.Range.Words(3)) = "letter" _
And objPara.Range.Words(4) = "words" Then
' Heading - Ignore
Else

If objPara.Range.Words.Count = 5 Then
sPerson(1) = Trim(objPara.Range.Words(1))
sPerson(2) = Trim(objPara.Range.Words(3))
sTray(1) = Trim(objPara.Range.Words(2))
sTray(2) = Trim(objPara.Range.Words(4))
ElseIf objPara.Range.Words.Count = 6 Then
sPerson(1) = Trim(objPara.Range.Words(1))
sPerson(2) = Trim(objPara.Range.Words(3)) & " " & Trim(objPara.Range.Words(4))
sTray(1) = Trim(objPara.Range.Words(2))
sTray(2) = Trim(objPara.Range.Words(5))
Else
' stuck for now!
MsgBox "Can't interpret Names"
End If
End If

Else
' This should be a list of words
Dim myword
For Each sWord In objPara.Range.Words
sWorkWord = UCase(Trim(sWord))
If Len(sWorkWord) < 2 Then
' Ignore commas, etc.
Else
sWorkTray = sTray(1)
sFromTray2 = ""
For i = 1 To Len(sWorkWord)
j = InStr(sWorkTray, Mid(sWorkWord, i, 1))
If j > 0 Then
Mid(sWorkTray, j, 1) = " "
Else
sFromTray2 = sFromTray2 & Mid(sWorkWord, i, 1)
End If
Next
lRow = lRow + 1
objSheet.Cells(lRow, 1) = sPerson(1)
objSheet.Cells(lRow, 2) = sWord
objSheet.Cells(lRow, 3) = sPerson(2)
objSheet.Cells(lRow, 4) = sFromTray2
End If
Next
End If

End If
Next

objWorkbook.SaveAs Replace(ActiveDocument.FullName, ".doc", ".xls")
objWorkbook.Close
objExcel.Quit
Set objSheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Set objPara = Nothing

End Sub

[katt67]

Thank you SOOOOOOOO much tony that was perfect you guys amaze me

[katt67]

I will let you know how well I did and the end of all this....thank you once again

[MOS MASTER]

Welcome to VBAX Kat, :yes

Very nice Tony! :hi:


and doesn't (quite) take forever to run!:rofl:

[johnske]

Yep, nyce one Tony... :thumb ...many thanx (as you can gather, I posted this question on katts behalf)