Solved

Break numbering between parenthesis into a new line

Posted on 2016-10-11
32
48 Views
Last Modified: 2016-10-29
Hello. I want to create a macro that allows me to separate numbering like this (i), (ii), (iii), etc., and (a), (b), (c), etc. and (1), (2), (3), etc. inside a paragraph and put each item on a separate line or paragraph, like this:

(i)
(ii)
(iii)
etc., and so on with any other type of numbering, be it a, b, c, or 1, 2, 3.

Anyone could hep me to create a macro to do this? I really appreciate your help as I am trying to learn some basics on VBA and start experimenting with my own documents. Can have been able to figure some things out but some others are too advanced for me. :-)

Thanks in advance for your help. Have an awesome day!

Paty
0
Comment
Question by:Pam Ross
  • 14
  • 13
  • 4
32 Comments
 
LVL 45

Expert Comment

by:aikimark
ID: 41838868
This should return what you want.  Please test.
Function Q_28975697(ByVal parmString As String) As String
    Static oRE As Object
    Dim oMatches As Object

    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "\(([^)]*)\)"
    End If

    If oRE.test(parmString) Then
        Set oMatches = oRE.Execute(parmString)
        Q_28975697 = oMatches(0).submatches(0)
    Else
        Q_28975697 = vbNullString
    End If

End Function

Open in new window

0
 

Author Comment

by:Pam Ross
ID: 41838896
Hi, aikimark. Thanks so much for replying. I tested the macro but when I run it it opens again the macros box to name and create the macro, although I had already created it. Really weird.

Thanks again for the quick reply and for your help.

Pat
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41838924
Where did you put the routine?
Are you running the code in an xlsm workbook or an xlsx workbook?
0
 

Author Comment

by:Pam Ross
ID: 41838931
Oh no. I'm running the macro in Word. Maybe that's why. :-) I need it for Word documents. I think I probably made a mistake when posting it in the Excel Topic.

Really sorry about that. Would you be able to tweek it to work in Word?

Thanks! :-)
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41838955
Where did you place the routine?
is this a docm or a docx document?
0
 

Author Comment

by:Pam Ross
ID: 41838977
For now it's a regular Word document docx because I'm just testing several macros to put them all in one macro docm file to share with colleagues. The others I have tested worked fine in a regular docx document.

Thanks!
:-)
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41838984
Where did you put the routine?
0
 

Author Comment

by:Pam Ross
ID: 41838996
Sorry to be so "beginner" and I just started learning about macros. Not sure what you mean by that. I created a new macro just for this routine in a new module. Not sure if you are referring to this.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41839005
This does need to be in a module.  I'm not sure why you might be getting any error/warning messages as a result of running the code.  What version of Word are you running?
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41839008
It probably got created in the NewMacros module -- that is where macros are created by default.  However, Word macros by definition are Sub procedures without arguments, and this procedure has an argument, so it would need to be redefined to actually work as a macro on the QAT or wherever you would want to run it.  

I think you want a macro that would run through the active document and move the numbered items to separate rows.  I could write a macro that does this -- it would be much easier if the only parentheses in the document are those around numbers -- is that the case?
0
 

Author Comment

by:Pam Ross
ID: 41839015
aikimark. I use Word 2010. Thanks.

Helen. Thanks for helping out also. Yes, the macro is in a NewMacros module. And yes, I need to put a paragraph break before each ( ) numbering inside a paragraph, as part of a larger macro I'm creating to clean format customized to work with my documents.

Thanks a million to both of you.
Pat
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41839047
My code is a function that requires the invoking code to pass a string and handle the returned string.  It does not iterate the document text.  You might be able to use a single find/replace operation without having to use VBA code.
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41839055
Perhaps you could do what you want with a simple Find and Replace operation -- replacing any ( with ^p(.  It is worth trying, in any case.  If that works, you can record the macro and build on it from that point.
Find & replace
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41839064
I have a template with a macro that does a lot of formatting (in this case, it formats VBA code).  It might be of help to you.  I tried to upload it, but EE won't upload .dotm docs.  Here is the FormatCode macro from this template:

Sub FormatCode()
'Created 03-26-1997 by Helen Feddema
'Last modified 11-10-2003

   Dim strTitle As String
   Dim strFindText As String
   Dim strReplaceText As String
   Dim rngSave As Range
   Dim strApostrophe As String
   Dim lngEnd As Long
   Dim rngEnd As Range
   Dim varPosition As Variant
   
   With Selection
      .WholeStory
      .Style = ActiveDocument.Styles("Code")
      .HomeKey Unit:=wdStory
      .Find.ClearFormatting
      .Find.Replacement.ClearFormatting
   End With
   
   'Insert page breaks between procedures
   strFindText = "^pSub"
   strReplaceText = "^p^mSub"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = strFindText
   strReplaceText = "^p^mPrivate Sub"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = "^pPrivate Sub"
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pFunction"
   strReplaceText = "^p^mFunction"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pProperty Get"
   strReplaceText = "^p^mProperty Get"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pProperty Let"
   strReplaceText = "^p^mProperty Let"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pProperty Set"
   strReplaceText = "^p^mProperty Set"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pPublic Function"
   strReplaceText = "^p^mPublic Function"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pPublic Sub"
   strReplaceText = "^p^mPublic Sub"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pPrivate Function"
   strReplaceText = "^p^mPrivate Function"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   'Format procedure headings with Heading 2 style
   Set rngSave = Selection.Range
   Selection.HomeKey Unit:=wdStory
   
   strFindText = "^p^mSub"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPrivate Sub"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mFunction"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mProperty"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPublic Function"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPublic Sub"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPrivate Function"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   'Apply Label style to labels
   strFindText = ":^p"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.HomeKey Unit:=wdLine
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Label")
         Selection.MoveRight Unit:=wdCharacter, Count:=1
         .Execute
      Wend
      rngSave.Select
   End With
   
   'Apply Comment style to comments
   strFindText = Chr$(39)
      With Selection.Find
         .ClearFormatting
         .Execute findtext:=strFindText
         While .Found = True
            'Test whether apostrophe is not at beginning of line
            varPosition = _
               Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
            'Debug.Print "Position of apostrophe: " & varPosition
            If varPosition < 140 Then
               Selection.EndKey Unit:=wdLine, Extend:=wdExtend
               Selection.Style = ActiveDocument.Styles("Comment")
               Selection.MoveRight Unit:=wdCharacter, Count:=1
               .Execute
            Else
               Selection.MoveRight Unit:=wdCharacter, Count:=1
               .Execute
            End If
         Wend
         rngSave.Select
      End With
   
   'Format document heading with Heading 2 style
   Selection.EndKey Unit:=wdLine, Extend:=wdExtend
   Selection.Style = ActiveDocument.Styles("Heading 2")
   Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
   strTitle = Selection
   
   If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
      ActiveWindow.Panes(2).Close
   End If
   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
      ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type _
       = wdMasterView Then
      ActiveWindow.ActivePane.View.Type = wdPageView
   End If
   
   'Suggest document title, and save user's choice to Title field
   If ActiveDocument.BuiltInDocumentProperties("Title") = "None" Then
      If Left(strTitle, 23) <> "Option Compare Database" Then
         ActiveDocument.BuiltInDocumentProperties("Title") = strTitle
      Else
         strTitle = InputBox(prompt:="Please enter the document name", Title:="Document Name", Default:="___ Form Module")
         ActiveDocument.BuiltInDocumentProperties("Title") = strTitle
         Selection.HomeKey Unit:=wdLine
         Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
         Selection.Delete Unit:=wdCharacter, Count:=1
         Selection.TypeText Text:=strTitle
         Selection.TypeParagraph
      End If
   End If
   
End Sub

Open in new window

0
 

Author Comment

by:Pam Ross
ID: 41839066
Thanks to both. Helen, I know what you mean, but that would separate all parentheses that are inside a paragraph (such as this, or an acronym). My problem is that I was trying to figure out how to create a macro that would only recognize numbering between parenthesis inside a paragraph.
Thanks! I will keep trying but if you can figure it out, let me know.
Thanks a lot.
Pat
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41839072
You would have to examine the character after the left parenthesis and check if it is numeric or one of the other characters that could be used for numbering.  But that is tough, since capital letters could be used, and they could also be the start of regular words.  Maybe check the next few letters to see if there is a right parenthesis -- that might work.
0
 

Author Comment

by:Pam Ross
ID: 41839073
Wow. Thanks for sharing your code Elena. I will look at it and see if there are sections that I might use,
Pat
0
 

Author Comment

by:Pam Ross
ID: 41839075
Thanks a lot. I learned a lot today. You are both great!

Pat
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41839097
If your replacement is contextual (sounds like it is), you should post some examples with different text that you want to change.  Post both a before and an after version of the text.
0
 

Author Comment

by:Pam Ross
ID: 41839139
Ok. Here it is one example with roman numerals.
BEFORE:
Before carrying out any other process, the  agency will submit the  plan to the  for approval, with details indicating: (i) the contracts for goods and services required to carry out the program; (ii) the proposed methods for the contracting of goods and for the selection of consultants; and (iii) the contract supervision procedures.
AFTER:
Before carrying out any other process, the  agency will submit the  plan to the  for approval, with details indicating:
(i) the contracts for goods and services required to carry out the program;
(ii) the proposed methods for the contracting of goods and for the selection of consultants; and
(iii) the contract supervision procedures.

Thanks.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41839157
Find and replace, using wildcards:
find: (\(?{1,4}\))
replace with: ^p\1
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41839163
Please note that there is a space character at the front and back ends of the Find string and at the end of the replace with string
0
 

Author Comment

by:Pam Ross
ID: 41839198
Thanks. It did the trick for most of the document, although in some cases it separated acronyms between parenthesis from their description. But don't worry, I think this is good enough.

Thanks a lot!
0
 

Author Comment

by:Pam Ross
ID: 41840727
Hi. It's me again. Turns out that having the acronyms between paragraphs separated too is after all a problem, and I haven't been able to figure out how to change the wildcard search to ask Word not to do it with uppercase.
Any ideas?
Thanks.
Pat
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41841836
Please post an example text or document that illustrates what you are talking about.
0
 

Author Comment

by:Pam Ross
ID: 41842473
Hi. Thanks for helping again. This is the text after applying the macro. As you can see, it divides a, b, and c, but it also divides the acronym (AFS). So my question would be, how to prevent acronyms from being separated on a different line.

At the meeting in Spain, the Board  requested that Management of the AFS (acting as administrator) shall, at the direction of the committee, develop a proposal on the future and financing of the ENN, which shall include
(a) a business plan and renewed vision for the ENN in the context of the reorganization of the AFS club
(AFS) private activities,
(b) a financial plan, and
(c) a strategy

Thanks.
Pat
0
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
ID: 41842586
Use this as the Find string: (\([0-9a-z]{1,4}\))
Again, note that there is a space before and after the delimiting (first and last) parenthesis characters
0
 

Author Comment

by:Pam Ross
ID: 41842596
Yay! You are a genious aikimark! It worked like a charm. I have so much to learn but you inspire me.

Thanks a lot for your kind support and patience.

Pat :-)
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41842958
I guess it's time to close this question
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41863862
Patricia

Please close this question
0
 

Author Closing Comment

by:Pam Ross
ID: 41865227
Thanks to aikimark for the great help. Sorry for the delay in closing the question. I didn't know it was me who was supposed to close it. Thank you!!!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now