Prev: Conditional Dropdowns on Steroids
Next: Multipage refresh
From: Micosoftfun on 13 Apr 2010 23:02
Is there a way to reverse the order of this macro (excract acronyms &
definitions)? Our acronyms are written as i.e., Blue Sky (BS), but this macro
is for the format: (BS) Blue Sky. It works beautifully, but just in the
wrong order. I certainly appreciate any advise or help I can get on this.

Sub ListAcronyms()
Dim strAcronym As String
Dim strDefine As String
Dim strOutput As String
Dim newDoc As Document

Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
ActiveWindow.View.ShowHiddenText = False

'Loop to find all acronyms
Do
'Search for acronyms using wildcards
Selection.Find.ClearFormatting
With Selection.Find
.ClearFormatting
.Text = "<[A-Z]@[A-Z]>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = True
.MatchWholeWord = True
.Execute
End With

'Only process if something found
If Selection.Find.Found Then
'Make a string from the selection, add it to the
'output string
strAcronym = Selection.Text

'Look for definition
Selection.MoveRight Unit:=wdWord
Selection.MoveRight Unit:=wdCharacter, _
Extend:=wdExtend
strDefine = ""
If Selection.Text = "(" Then
While Selection <> ")"
strDefine = strDefine & Selection.Text
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveRight Unit:=wdCharacter, _
Extend:=wdExtend
Wend
End If
Selection.Collapse Direction:=wdCollapseEnd
If Left(strDefine, 1) = "(" Then
strDefine = Mid(strDefine, 2, Len(strDefine))
End If
If strDefine > "" Then
'Check if the search result is in the Output string
'if it is, ignore the search result
If InStr(strOutput, strAcronym) = 0 Then
strOutput = strOutput & strAcronym _
& vbTab & strDefine & vbCr
End If
End If
End If
Loop Until Not Selection.Find.Found

'Create new document and change active document
Set newDoc = Documents.Add

'Insert the text
Selection.TypeText Text:=strOutput

'Sort it
newDoc.Content.Sort SortOrder:=wdSortOrderAscending
Application.ScreenUpdating = True
Selection.HomeKey Unit:=wdStory
End Sub

Thank YOU!
From: Doug Robbins - Word MVP on 14 Apr 2010 01:27
The problem that I can see is how is the code supposed to know how many
words before the ( are to be included in the definition

Blue Sky (BS)
Big Blue Sky (BBS)

Does the acronym always consist of the same number of letters as there are
words in its definition?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

"Micosoftfun" <Micosoftfun(a)discussions.microsoft.com> wrote in message
news:FDC2A485-FEFE-467D-955C-CF85FF99047B(a)microsoft.com...
> Is there a way to reverse the order of this macro (excract acronyms &
> definitions)? Our acronyms are written as i.e., Blue Sky (BS), but this
> macro
> is for the format: (BS) Blue Sky. It works beautifully, but just in the
> wrong order. I certainly appreciate any advise or help I can get on this.
>
> Sub ListAcronyms()
> Dim strAcronym As String
> Dim strDefine As String
> Dim strOutput As String
> Dim newDoc As Document
>
> Application.ScreenUpdating = False
> Selection.HomeKey Unit:=wdStory
> ActiveWindow.View.ShowHiddenText = False
>
> 'Loop to find all acronyms
> Do
> 'Search for acronyms using wildcards
> Selection.Find.ClearFormatting
> With Selection.Find
> .ClearFormatting
> .Text = "<[A-Z]@[A-Z]>"
> .Replacement.Text = ""
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = True
> .MatchWildcards = True
> .MatchWholeWord = True
> .Execute
> End With
>
> 'Only process if something found
> If Selection.Find.Found Then
> 'Make a string from the selection, add it to the
> 'output string
> strAcronym = Selection.Text
>
> 'Look for definition
> Selection.MoveRight Unit:=wdWord
> Selection.MoveRight Unit:=wdCharacter, _
> Extend:=wdExtend
> strDefine = ""
> If Selection.Text = "(" Then
> While Selection <> ")"
> strDefine = strDefine & Selection.Text
> Selection.Collapse Direction:=wdCollapseEnd
> Selection.MoveRight Unit:=wdCharacter, _
> Extend:=wdExtend
> Wend
> End If
> Selection.Collapse Direction:=wdCollapseEnd
> If Left(strDefine, 1) = "(" Then
> strDefine = Mid(strDefine, 2, Len(strDefine))
> End If
> If strDefine > "" Then
> 'Check if the search result is in the Output string
> 'if it is, ignore the search result
> If InStr(strOutput, strAcronym) = 0 Then
> strOutput = strOutput & strAcronym _
> & vbTab & strDefine & vbCr
> End If
> End If
> End If
> Loop Until Not Selection.Find.Found
>
> 'Create new document and change active document
> Set newDoc = Documents.Add
>
> 'Insert the text
> Selection.TypeText Text:=strOutput
>
> 'Sort it
> newDoc.Content.Sort SortOrder:=wdSortOrderAscending
> Application.ScreenUpdating = True
> Selection.HomeKey Unit:=wdStory
> End Sub
>
> Thank YOU!

From: Micosoftfun on 14 Apr 2010 20:29
Thank you for looking into this. You are so right. How is the code suppose
to know how many words?

Our acronymns are anywhere from 2 to 3, even 4 characters. If I could just
get the program to recognize the first capital letter which would be the
first word, of course. For instance, Now Is The Time (NITT). I guess I'm
dreaming. Thank you again.

"Doug Robbins - Word MVP" wrote:I

> The problem that I can see is how is the code supposed to know how many
> words before the ( are to be included in the definition
>
> Blue Sky (BS)
> Big Blue Sky (BBS)
>
> Does the acronym always consist of the same number of letters as there are
> words in its definition?
>
> --
> Hope this helps.
>
> Please reply to the newsgroup unless you wish to avail yourself of my
> services on a paid consulting basis.
>
> Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
>
> "Micosoftfun" <Micosoftfun(a)discussions.microsoft.com> wrote in message
> news:FDC2A485-FEFE-467D-955C-CF85FF99047B(a)microsoft.com...
> > Is there a way to reverse the order of this macro (excract acronyms &
> > definitions)? Our acronyms are written as i.e., Blue Sky (BS), but this
> > macro
> > is for the format: (BS) Blue Sky. It works beautifully, but just in the
> > wrong order. I certainly appreciate any advise or help I can get on this.
> >
> > Sub ListAcronyms()
> > Dim strAcronym As String
> > Dim strDefine As String
> > Dim strOutput As String
> > Dim newDoc As Document
> >
> > Application.ScreenUpdating = False
> > Selection.HomeKey Unit:=wdStory
> > ActiveWindow.View.ShowHiddenText = False
> >
> > 'Loop to find all acronyms
> > Do
> > 'Search for acronyms using wildcards
> > Selection.Find.ClearFormatting
> > With Selection.Find
> > .ClearFormatting
> > .Text = "<[A-Z]@[A-Z]>"
> > .Replacement.Text = ""
> > .Forward = True
> > .Wrap = wdFindStop
> > .Format = False
> > .MatchCase = True
> > .MatchWildcards = True
> > .MatchWholeWord = True
> > .Execute
> > End With
> >
> > 'Only process if something found
> > If Selection.Find.Found Then
> > 'Make a string from the selection, add it to the
> > 'output string
> > strAcronym = Selection.Text
> >
> > 'Look for definition
> > Selection.MoveRight Unit:=wdWord
> > Selection.MoveRight Unit:=wdCharacter, _
> > Extend:=wdExtend
> > strDefine = ""
> > If Selection.Text = "(" Then
> > While Selection <> ")"
> > strDefine = strDefine & Selection.Text
> > Selection.Collapse Direction:=wdCollapseEnd
> > Selection.MoveRight Unit:=wdCharacter, _
> > Extend:=wdExtend
> > Wend
> > End If
> > Selection.Collapse Direction:=wdCollapseEnd
> > If Left(strDefine, 1) = "(" Then
> > strDefine = Mid(strDefine, 2, Len(strDefine))
> > End If
> > If strDefine > "" Then
> > 'Check if the search result is in the Output string
> > 'if it is, ignore the search result
> > If InStr(strOutput, strAcronym) = 0 Then
> > strOutput = strOutput & strAcronym _
> > & vbTab & strDefine & vbCr
> > End If
> > End If
> > End If
> > Loop Until Not Selection.Find.Found
> >
> > 'Create new document and change active document
> > Set newDoc = Documents.Add
> >
> > 'Insert the text
> > Selection.TypeText Text:=strOutput
> >
> > 'Sort it
> > newDoc.Content.Sort SortOrder:=wdSortOrderAscending
> > Application.ScreenUpdating = True
> > Selection.HomeKey Unit:=wdStory
> > End Sub
> >
> > Thank YOU!
>
From: Greg Maxey on 14 Apr 2010 21:28
Not thoroughlty tested but may suit your needs:

Sub ListAcronyms()
Dim oRng As Word.Range
Dim strAcronym As String
Dim strDefine As String
Dim strOutput As String
Dim newDoc As Document
Dim rngEndPoint As Range
Dim defRange As Word.Range
ActiveWindow.View.ShowHiddenText = False
Application.ScreenUpdating = False
Set oRng = ActiveDocument.Content
With oRng.Find
.ClearFormatting
.Text = "<[A-Z]@[A-Z]>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = True
.MatchWholeWord = True
While .Execute
Set rngEndPoint = oRng.Duplicate
rngEndPoint.Start = oRng.End
strAcronym = oRng.Text
Set defRange = oRng.Duplicate
defRange.MoveStartUntil Cset:="(", Count:=wdBackward
defRange.End = defRange.Start
If defRange.Characters.First.Previous = "(" Then
defRange.MoveEndUntil Cset:=")", Count:=wdForward
strDefine = defRange.Text
If strDefine > "" Then
If InStr(strOutput, strAcronym) = 0 Then
strOutput = strOutput & strAcronym & vbTab & strDefine & vbCr
End If
End If
End If
'rngEndPoint.Select
Wend
End With
Set newDoc = Documents.Add
'Insert and sort text
With newDoc
.Range.Text = strOutput
.Content.Sort SortOrder:=wdSortOrderAscending
End With
Application.ScreenUpdating = True
End Sub





Micosoftfun wrote:
> Thank you for looking into this. You are so right. How is the code
> suppose to know how many words?
>
> Our acronymns are anywhere from 2 to 3, even 4 characters. If I
> could just get the program to recognize the first capital letter
> which would be the first word, of course. For instance, Now Is The
> Time (NITT). I guess I'm dreaming. Thank you again.
>
> "Doug Robbins - Word MVP" wrote:I
>
>> The problem that I can see is how is the code supposed to know how
>> many words before the ( are to be included in the definition
>>
>> Blue Sky (BS)
>> Big Blue Sky (BBS)
>>
>> Does the acronym always consist of the same number of letters as
>> there are words in its definition?
>>
>> --
>> Hope this helps.
>>
>> Please reply to the newsgroup unless you wish to avail yourself of my
>> services on a paid consulting basis.
>>
>> Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
>>
>> "Micosoftfun" <Micosoftfun(a)discussions.microsoft.com> wrote in
>> message news:FDC2A485-FEFE-467D-955C-CF85FF99047B(a)microsoft.com...
>>> Is there a way to reverse the order of this macro (excract acronyms
>>> & definitions)? Our acronyms are written as i.e., Blue Sky (BS),
>>> but this macro
>>> is for the format: (BS) Blue Sky. It works beautifully, but just
>>> in the wrong order. I certainly appreciate any advise or help I
>>> can get on this.
>>>
>>> Sub ListAcronyms()
>>> Dim strAcronym As String
>>> Dim strDefine As String
>>> Dim strOutput As String
>>> Dim newDoc As Document
>>>
>>> Application.ScreenUpdating = False
>>> Selection.HomeKey Unit:=wdStory
>>> ActiveWindow.View.ShowHiddenText = False
>>>
>>> 'Loop to find all acronyms
>>> Do
>>> 'Search for acronyms using wildcards
>>> Selection.Find.ClearFormatting
>>> With Selection.Find
>>> .ClearFormatting
>>> .Text = "<[A-Z]@[A-Z]>"
>>> .Replacement.Text = ""
>>> .Forward = True
>>> .Wrap = wdFindStop
>>> .Format = False
>>> .MatchCase = True
>>> .MatchWildcards = True
>>> .MatchWholeWord = True
>>> .Execute
>>> End With
>>>
>>> 'Only process if something found
>>> If Selection.Find.Found Then
>>> 'Make a string from the selection, add it to the
>>> 'output string
>>> strAcronym = Selection.Text
>>>
>>> 'Look for definition
>>> Selection.MoveRight Unit:=wdWord
>>> Selection.MoveRight Unit:=wdCharacter, _
>>> Extend:=wdExtend
>>> strDefine = ""
>>> If Selection.Text = "(" Then
>>> While Selection <> ")"
>>> strDefine = strDefine & Selection.Text
>>> Selection.Collapse Direction:=wdCollapseEnd
>>> Selection.MoveRight Unit:=wdCharacter, _
>>> Extend:=wdExtend
>>> Wend
>>> End If
>>> Selection.Collapse Direction:=wdCollapseEnd
>>> If Left(strDefine, 1) = "(" Then
>>> strDefine = Mid(strDefine, 2, Len(strDefine))
>>> End If
>>> If strDefine > "" Then
>>> 'Check if the search result is in the Output string
>>> 'if it is, ignore the search result
>>> If InStr(strOutput, strAcronym) = 0 Then
>>> strOutput = strOutput & strAcronym _
>>> & vbTab & strDefine & vbCr
>>> End If
>>> End If
>>> End If
>>> Loop Until Not Selection.Find.Found
>>>
>>> 'Create new document and change active document
>>> Set newDoc = Documents.Add
>>>
>>> 'Insert the text
>>> Selection.TypeText Text:=strOutput
>>>
>>> 'Sort it
>>> newDoc.Content.Sort SortOrder:=wdSortOrderAscending
>>> Application.ScreenUpdating = True
>>> Selection.HomeKey Unit:=wdStory
>>> End Sub
>>>
>>> Thank YOU!


From: Greg Maxey on 14 Apr 2010 23:06
Doh!! After posting earlier I realized that your format is Blue Sky (BS) and
not (Blue Sky) BS. Sorry.


Greg Maxey wrote:
> Not thoroughlty tested but may suit your needs:
>
> Sub ListAcronyms()
> Dim oRng As Word.Range
> Dim strAcronym As String
> Dim strDefine As String
> Dim strOutput As String
> Dim newDoc As Document
> Dim rngEndPoint As Range
> Dim defRange As Word.Range
> ActiveWindow.View.ShowHiddenText = False
> Application.ScreenUpdating = False
> Set oRng = ActiveDocument.Content
> With oRng.Find
> .ClearFormatting
> .Text = "<[A-Z]@[A-Z]>"
> .Replacement.Text = ""
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = True
> .MatchWildcards = True
> .MatchWholeWord = True
> While .Execute
> Set rngEndPoint = oRng.Duplicate
> rngEndPoint.Start = oRng.End
> strAcronym = oRng.Text
> Set defRange = oRng.Duplicate
> defRange.MoveStartUntil Cset:="(", Count:=wdBackward
> defRange.End = defRange.Start
> If defRange.Characters.First.Previous = "(" Then
> defRange.MoveEndUntil Cset:=")", Count:=wdForward
> strDefine = defRange.Text
> If strDefine > "" Then
> If InStr(strOutput, strAcronym) = 0 Then
> strOutput = strOutput & strAcronym & vbTab & strDefine & vbCr
> End If
> End If
> End If
> 'rngEndPoint.Select
> Wend
> End With
> Set newDoc = Documents.Add
> 'Insert and sort text
> With newDoc
> .Range.Text = strOutput
> .Content.Sort SortOrder:=wdSortOrderAscending
> End With
> Application.ScreenUpdating = True
> End Sub
>
>
>
>
>
> Micosoftfun wrote:
>> Thank you for looking into this. You are so right. How is the code
>> suppose to know how many words?
>>
>> Our acronymns are anywhere from 2 to 3, even 4 characters. If I
>> could just get the program to recognize the first capital letter
>> which would be the first word, of course. For instance, Now Is The
>> Time (NITT). I guess I'm dreaming. Thank you again.
>>
>> "Doug Robbins - Word MVP" wrote:I
>>
>>> The problem that I can see is how is the code supposed to know how
>>> many words before the ( are to be included in the definition
>>>
>>> Blue Sky (BS)
>>> Big Blue Sky (BBS)
>>>
>>> Does the acronym always consist of the same number of letters as
>>> there are words in its definition?
>>>
>>> --
>>> Hope this helps.
>>>
>>> Please reply to the newsgroup unless you wish to avail yourself of
>>> my services on a paid consulting basis.
>>>
>>> Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
>>>
>>> "Micosoftfun" <Micosoftfun(a)discussions.microsoft.com> wrote in
>>> message news:FDC2A485-FEFE-467D-955C-CF85FF99047B(a)microsoft.com...
>>>> Is there a way to reverse the order of this macro (excract acronyms
>>>> & definitions)? Our acronyms are written as i.e., Blue Sky (BS),
>>>> but this macro
>>>> is for the format: (BS) Blue Sky. It works beautifully, but just
>>>> in the wrong order. I certainly appreciate any advise or help I
>>>> can get on this.
>>>>
>>>> Sub ListAcronyms()
>>>> Dim strAcronym As String
>>>> Dim strDefine As String
>>>> Dim strOutput As String
>>>> Dim newDoc As Document
>>>>
>>>> Application.ScreenUpdating = False
>>>> Selection.HomeKey Unit:=wdStory
>>>> ActiveWindow.View.ShowHiddenText = False
>>>>
>>>> 'Loop to find all acronyms
>>>> Do
>>>> 'Search for acronyms using wildcards
>>>> Selection.Find.ClearFormatting
>>>> With Selection.Find
>>>> .ClearFormatting
>>>> .Text = "<[A-Z]@[A-Z]>"
>>>> .Replacement.Text = ""
>>>> .Forward = True
>>>> .Wrap = wdFindStop
>>>> .Format = False
>>>> .MatchCase = True
>>>> .MatchWildcards = True
>>>> .MatchWholeWord = True
>>>> .Execute
>>>> End With
>>>>
>>>> 'Only process if something found
>>>> If Selection.Find.Found Then
>>>> 'Make a string from the selection, add it to the
>>>> 'output string
>>>> strAcronym = Selection.Text
>>>>
>>>> 'Look for definition
>>>> Selection.MoveRight Unit:=wdWord
>>>> Selection.MoveRight Unit:=wdCharacter, _
>>>> Extend:=wdExtend
>>>> strDefine = ""
>>>> If Selection.Text = "(" Then
>>>> While Selection <> ")"
>>>> strDefine = strDefine & Selection.Text
>>>> Selection.Collapse Direction:=wdCollapseEnd
>>>> Selection.MoveRight Unit:=wdCharacter, _
>>>> Extend:=wdExtend
>>>> Wend
>>>> End If
>>>> Selection.Collapse Direction:=wdCollapseEnd
>>>> If Left(strDefine, 1) = "(" Then
>>>> strDefine = Mid(strDefine, 2, Len(strDefine))
>>>> End If
>>>> If strDefine > "" Then
>>>> 'Check if the search result is in the Output string
>>>> 'if it is, ignore the search result
>>>> If InStr(strOutput, strAcronym) = 0 Then
>>>> strOutput = strOutput & strAcronym _
>>>> & vbTab & strDefine & vbCr
>>>> End If
>>>> End If
>>>> End If
>>>> Loop Until Not Selection.Find.Found
>>>>
>>>> 'Create new document and change active document
>>>> Set newDoc = Documents.Add
>>>>
>>>> 'Insert the text
>>>> Selection.TypeText Text:=strOutput
>>>>
>>>> 'Sort it
>>>> newDoc.Content.Sort SortOrder:=wdSortOrderAscending
>>>> Application.ScreenUpdating = True
>>>> Selection.HomeKey Unit:=wdStory
>>>> End Sub
>>>>
>>>> Thank YOU!


 | 
Pages: 1
Prev: Conditional Dropdowns on Steroids
Next: Multipage refresh