Convert to one line address.

[Sigh]

Hi,
I would like to write a macro to convert the following
address to only one line, so I can import in to the Excel
easily. Examples :

AAA XXXX STORES LTD.
1370 SONY PLACE
Sanigo, CANADA
R3C 3C3

TO

AAA XXXX STORES LTD, 1370 SONY PLACE Sanigo, CANADA R3C 3C3

Some of the address have 5 or 6 rows and also the empty
line between each address. How can I convert to only one
line.

Any help would be very appreciated.

 

[Andrew]

I've only quickly done it, while i check for help myself,
on the next subject...

Select Each Address seperately then run the sub Convert.
It does a simple replacement of the CR character to
a ", ". It would be possible to select blank lines
or "CR" & "CR" character sequence and re-insert a line end
(CR) character.

AnyWay give it a try..


Sub Convert()
Dim t, nt, m, tmp As String, n, L As Integer
With Selection
t = .Text
L = Len(t)
For n = 1 To L
m = Mid(t, n, 1)
tmp = Right(t, (Len(t) - (n - 1)))
If Asc(m) = 13 Then
t = Mid(t, 1, n - 1) + ", " + Right(t, (Len(t) - (n)))
End If
Next n
..Text = t
End With
End Sub

' Good Luck, Andrew

 

[Sigh]

Thanks for help. But my text file contend alot of Lines
(address) almost more then 300 address. Is't anything that
I can ran the macro to convert all at once. Instead of
select each one address at a time to convert. Because it
take so much time consume. It's any macro that I get in
from?

Thanks

 

[Larry]

This is quite possible but I don't have the time to put together the
macro for you now.

 

[Larry]

This will do what you want. It's not absolutely perfect, as it may
leave an extra comma here or there, but it basically does what I think
you're asking for.

Larry

Sub JoinAddressLinesIntoOne()

' Turns selected lines separated by one paragraph into a single line
with comma separators.
'Separate addresses need to be separated by at least two paragraph marks
before running macro.
' Works in conjunction with DoJoinParas function below.
' Operates either from insertion point to end of document or on
selection.

' Make range of selection in order to return to it
Dim r As Range
Set r = Selection.Range

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.MatchWildcards = False

' Change all line breaks to paragraph marks
Call DoJoinParas("^l", "^p", False)

' Set aside double para breaks so as not to change them
Call DoJoinParas("^13{2,}", "*&*", True)

' Change two spaces followed by para break to two spaces
Call DoJoinParas(" ^p", ", ", False)

' Change one space followed by para break to one space
Call DoJoinParas(" ^p", ", ", False)

' Change sole para break to one space
Call DoJoinParas("^p", ", ", False)

' restore the double para breaks.
Call DoJoinParas("*&*", "^p^p", False)

' change single hyphens surrounded by space to double nonbreaking
hyphens
Call DoJoinParas(" - ", "^~-", False)

' Clear up comma at end of last affected line
Application.ScreenUpdating = False
Selection.Collapse wdCollapseEnd
Selection.MoveStartWhile cset:=", ", Count:=wdBackward
Selection.Delete
r.Select
Selection.Collapse wdCollapseStart


' clear Find box
With Selection.Find
..Text = ""
..Replacement.Text = ""
End With
End Sub


Sub DoJoinParas(findText As String, ReplaceText As String, _
bMatchWildCards As Boolean)

With Selection.Find
.MatchWildcards = bMatchWildCards
.Text = findText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
' Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 

[Larry]

This is slightly improved, as it deleted any leftover comma at end of
document.

Remember, you can run this either from the beginning of document or some
point in document, or select text and run the macro on the selection.


Sub JoinAddressLinesIntoOne()
' by Larry

' Works in conjunction with DoJoinParas function below.
' Operates either from insertion point to end of doc or on selection.

' Make range of selection in order to return to it
Dim r As Range
Set r = Selection.Range

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.MatchWildcards = False
' Change all line breaks to paragraph marks
Call DoJoinParas("^l", "^p", False)

' Set aside double para breaks so as not to change them
Call DoJoinParas("^13{2,}", "*&*", True)

' Change two spaces followed by para break to two spaces
Call DoJoinParas(" ^p", ", ", False)

' Change one space followed by para break to one space
Call DoJoinParas(" ^p", ", ", False)

' Change sole para break to one space
Call DoJoinParas("^p", ", ", False)

' restore the double para breaks.
Call DoJoinParas("*&*", "^p^p", False)

' change single hyphens surrounded by space to double nonbreaking
hyphens
Call DoJoinParas(" - ", "^~-", False)

' Clear up comma at end of last affected line
Application.ScreenUpdating = False
Selection.Collapse wdCollapseEnd
Selection.MoveStartWhile cset:=", ", Count:=wdBackward
Selection.Delete

' Clear up comma at end of document
Selection.EndKey wdStory
Selection.MoveStartWhile cset:=", ", Count:=wdBackward
Selection.Delete

' return cursor to starting point or to beginning of selection, and
dismiss selection.
r.Select
Selection.Collapse wdCollapseStart


' clear Find box
With Selection.Find
..Text = ""
..Replacement.Text = ""
End With
End Sub


Sub DoJoinParas(findText As String, ReplaceText As String, _
bMatchWildCards As Boolean)

With Selection.Find
.MatchWildcards = bMatchWildCards
.Text = findText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
' Selection.Find.Execute Replace:=wdReplaceAll
End Sub