Parsing a Cell into three seperate Words 1

[TuLSaViPeR]

I was able (with some help) to parse some data out of MS
Word tables into a format that I can import into access or
SQL Server. Next (not as much help & alot of work) I was
able to Seperate the the name(Kevin A Polin) into (3)
seperate words by using the [Range.word(6)].

HERE IS MY PROBLEM:
I have an address in table 23, it's on (2) seperate lines.
SAMPLE: I have this
-------------------------------------------------
420 S. Pottenger
Los Angeles, Ca 90068
-------------------------------------------------
I am trying to split this Table as I did with the name.
and put it on (1) line.
EXAMPLE: I want this
-------------------------------------------------
+420 S. Pottenger+Los Angeles+Ca+90068+
-------------------------------------------------
this is what Code I have:
-------------------------------------------------
Set Addressrange = tempdoc.Paragraphs(23).Range
Addressrange.End = Addressrange.End - 1

Set Cityrange = sourcedoc.Tables(i).Range.Words(71)
Set Staterange = sourcedoc.Tables(i).Range.Words(73)
Set Ziprange = sourcedoc.Tables(i).Range.Words(74)
-------------------------------------------------

I need to split the 23rd table into the following elements
+Address+City+State+Zip+

CAN SOMONE PLEASE HELP? ITS NOT COMING TO MY MIND... I AM
DEAD DUE TO LACK OF SLEEP.

----------------------------------------------------
'START CODE

Sub a()

' DECLARES THE VARIABLES FOR THE TYPE OF DOCUMENTS
Dim sourcedoc As Document
Dim tempdoc As Document
Dim datadoc As Document
' END DOCUMENT DECLARATIONS


' DECLARES THE VARIABLES FOR THE LOOPING
Dim i As Integer
' END LOOPING DECLARATIONS


' DECLARES THE VARIABLES FOR THE DATA
Dim First As Range
Dim Middle As Range
Dim last As Range
Dim SS As Range
Dim HomePhone As Range
Dim WorkPhone As Range
Dim Email As Range
Dim Address As Range
Dim City As Range
Dim State As Range
Dim Zip As Range
Dim Incentives As Range
Dim LeadSource As Range
Dim DateTransmitted As Range
Dim LoanType As Range
Dim MortgageProduct As Range
Dim Amount As Range
Dim Rate As Range
Dim Status As Range
Dim AssignedTo As Range
Dim OfOffers As Range

' END DATA DECLARATIONS

' PREPARE THE DOCUMENTS
' 1.) Verify original document
' 2.) Create a temporary document to prevent Corruption
' 3.) add data to new document
Set sourcedoc = ActiveDocument
Set tempdoc = Documents.Add
Set datadoc = Documents.Add
sourcedoc.Activate
' END DOCUMENT PREPARATIONS

' THIS PREPARES THE SCRIPT TO LOOP
For i = 1 To sourcedoc.Tables.Count
tempdoc.Range.InsertAfter sourcedoc.Tables(i).Range
' END LOOPING CODE

' EXTRACT THE DATA FROM THE TABLES AND ADD TO TEMPORARY
DOCUMENT
Set Firstrange = sourcedoc.Tables(i).Range.Words(6)
Set Middlerange = sourcedoc.Tables(i).Range.Words(7)
Set Lastrange = sourcedoc.Tables(i).Range.Words(8)

Set SSrange = tempdoc.Paragraphs(7).Range
SSrange.End = SSrange.End - 1

Set Homephonerange = tempdoc.Paragraphs(11).Range
Homephonerange.End = Homephonerange.End - 1

Set Workphonerange = tempdoc.Paragraphs(15).Range
Workphonerange.End = Workphonerange.End - 1

Set Emailrange = tempdoc.Paragraphs(19).Range
Emailrange.End = Emailrange.End - 1

Set Addressrange = tempdoc.Paragraphs(23).Range
Addressrange.End = Addressrange.End - 1

Set Cityrange = sourcedoc.Tables(i).Range.Words(71)
Set Staterange = sourcedoc.Tables(i).Range.Words(73)
Set Ziprange = sourcedoc.Tables(i).Range.Words(74)

Set Incentivesrange = tempdoc.Paragraphs(27).Range
Incentivesrange.End = Incentivesrange.End - 1

Set LeadSourcerange = tempdoc.Paragraphs(32).Range
LeadSourcerange.End = LeadSourcerange.End - 1

Set DateTransmittedrange = tempdoc.Paragraphs(36).Range
DateTransmittedrange.End = DateTransmittedrange.End - 1

Set LoanTyperange = tempdoc.Paragraphs(40).Range
LoanTyperange.End = LoanTyperange.End - 1

Set MortgageProductrange = tempdoc.Paragraphs(44).Range
MortgageProductrange.End = MortgageProductrange.End - 1

Set Amountrange = tempdoc.Paragraphs(48).Range
Amountrange.End = Amountrange.End - 1

Set Raterange = tempdoc.Paragraphs(52).Range
Raterange.End = Raterange.End - 1

Set Statusrange = tempdoc.Paragraphs(59).Range
Statusrange.End = Statusrange.End - 1

Set AssignedTorange = tempdoc.Paragraphs(63).Range
AssignedTorange.End = AssignedTorange.End - 1

Set OfOffersrange = tempdoc.Paragraphs(67).Range


' END DATA EXTRACTION

' FORMAT DATA FROM TABLES THEN INSERT INTO NEW DOCUMENT
datadoc.Range.InsertAfter Firstrange & "+" & Middlerange
& "+" & Lastrange & "+" & SSrange & "+" & Homephonerange
& "+" & Workphonerange & "+" & Emailrange & "+" &
Addressrange & "+" & Cityrange & "+" & Staterange & "+" &
Ziprange & "+" & Incentivesrange & "+" & LeadSourcerange
& "+" & DateTransmittedrange & "+" & LoanTyperange & "+" &
MortgageProductrange & "+" & Amountrange & "+" & Raterange
& "+" & Statusrange & "+" & AssignedTorange & "+" &
OfOffersrange
' END FORMATING AND INSERTION OF DATA

' DELETE TEMPORARY DATA
tempdoc.Range.Delete

' END DELETE

' SEARCH FOR MORE DATA IF ADDITIONAL DATA THEN LOOP
Next i
' END SEARCH

' CLOSE TEMPORARY DATA AND DO NOT SAVE CHANGES
tempdoc.Close wdDoNotSaveChanges
' MAKE THE NEW DOCUMENT THE ACTIVE PAGE
datadoc.Activate
' END DOCUMENT CHANGES

End Sub

'END CODE
----------------------------------------------------

Thanks

 

[TuLSaViPeR]

Please Help!

 

[TuLSaViPeR]

Ok , Ok please everybody do not respond at the same time.

 

[xlbo]

Well that won't get you any help - people aren't required to help you - no-one gets paid for this. If people don't know the answer / don't want to help they won't Rgds
Geoff
"Some cause happiness wherever they go; others whenever they go."
-Oscar Wilde