How replace a String with Starting line in the MS Word
example
The Statue of Liberty of New York was (a) gifted by which country?
(a) Britain
(b) France
(c) Germany
(d) Spain
Here (a) only need to replace with (A) which is Line Starting
output like
The Statue of Liberty of New York was (a) gifted by which country?
(A) Britain
(b) France
(c) Germany
(d) Spain
With Selection.Find
.Text = "^\(a\)"
.Replacement.Text = "(A)"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
This code replaces all (a) at the beginning of the paragraph with (A):
Sub ReplA()
With ActiveDocument.Range
.Find.Text = "(a)"
Do While .Find.Execute
If .Start = .Paragraphs(1).Range.Start Then .Text = "(A)"
Loop
End With
End Sub
Before
(a) first line
The Statue of Liberty of New York was (a) gifted by which country?
(a) Britain
(b) France
(c) Germany
(d) Spain (a)
(a) will also be changed
After
(A) first line
The Statue of Liberty of New York was (a) gifted by which country?
(A) Britain
(b) France
(c) Germany
(d) Spain (a)
(A) will also be changed
Related
I have a document containing tags, and now I would like to delete all the tags in headings only. Please refer to the example below. The tags also appear in the content as well, but I only need to delete the tags in Heading1, Heading2, Heading3.
e.g.
(before)
1 Hello world[A]
1.1 Hello Tokyo[A][B]
1.1.1 Hello NYC[C]
blablablabla[A][B]
(after)
1 Hello world
1.1 Hello Tokyo
1.1.1 Hello NYC
blablablabla[A][B]
The following is my code to work, but the result shows the tags in the content are deleted too. Take the above as example, [A]and[B] in blablablabla[A][B] are also deleted with my code. Please help me find out is there anything wrong in my code, thanks!
Sub mainsub()
DeleteBrackets wdStyleHeading1
DeleteBrackets wdStyleHeading2
DeleteBrackets wdStyleHeading3
'I have other code in my main sub, just show my way to call the functioin
End Sub
Public Sub DeleteBrackets(headingStyle As WdBuiltinStyle)
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = headingStyle
.Text = "\[*\]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Change
.Format = False
to
.Format = True
I want a quick way to deidentify documents by removing employees' signatures in comments (yes, I already have one that removes identifying info, just not the text itself). A macro that could search all employee names and replace with "" would be great. I'm sure there is a simple way to do this.
Everything I've tried has failed, either not finding text in comments or not working after I copy/paste the recorded code for Find/Replace one name and adjust for the other 20-30 names. I've tried probably 4 different find/replace codes that work for the main text, but none have worked for the comments.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Employee Name 1"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Employee Name 2"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Copying/pasting this through all 20-30 employees fails (no error, just doesn't replace). I'm sure there's a more elegant way to do it anyway, but I'm definitely not familiar enough with code.
It's not 100% clear from the phrasing in the question whether code for removing the comments' author and initials is also required, or just text in the comments that refers to employees' names. So the code below does both.
First, an array is declared and populated with the employees' names that should be removed. This will make it easier to manage the list and shorten the amount of code (doesn't need to be copy/pasted for each employee).
Then, the collection of comments is looped and two tests are perfomed.
Does the comment text contain any employee's name. To determine this, the array of employee names is looped and the presence of the name checked using Instr. If a name is present, Find/Replace is run on the Comment.Range. (Note: this code contains only the barebones Find properties, you may need to add some things if more is needed.)
Remove Authorand Initial information. Here, the list of author names is part of the Case test. If a comment contains one of them, the Author and Initial information is set to an empty string.
Note that it comment's Range does not include the comment's author or initials information, only the content of the comment (which you may know, but others reading this may not).
Sub RemoveAuthorFromAllComments() ' TestLoopCommentWords()
Dim C As Word.Comment, rng As Word.Range
Dim employees() As Variant, e As Variant
employees = Array("Cindy Meister", "John Doe", "Mary Jane")
For Each C In ActiveDocument.Comments
Set rng = C.Range
For Each e In employees
If InStr(rng, e) <> 0 Then
With rng.Find
.Text = e
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End If
Next
Select Case C.Author
Case "Cindy Meister", "John Doe", "Mary Jane"
C.Author = ""
C.Initial = ""
Case Else
Debug.Print C.Author
End Select
Next
End Sub
I'm trying to replace numbering (Word's 1. , 2. , etc.). In a simple string and replace search but I can't seem to find the numbers.
This is for Word 365, and I'm using the VB editor in there.
Sub ayaya()
Documents.Open FileName:=ActiveDocument.Path + "\Doc1.docm"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "SSS"
.Replacement.Text = "PPP"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceAll
End With
End Sub
My word document looked like this:
SSS
SSS
1. SSS
and turned to
PPP
PPP
1. PPP
but when I replace the search to any variation of
With Selection.Find
.Text = "1. SSS"
It does not find the text.
You are not finding the number associated with the paragraph text because it most likely is a ListLevelNumber and these are automatically generated by the ListFormat style. In other words, they are not part of the physical text that can be found using a Search, at least the way you currently have it setup in your code.
A separate Search would be required to find the ListParagraph Style being used and then some additional code that would manipulate the ListLevelNumber if that is what you are attempting to do.
Below is example code that determines what the ListLevelNumber is on a given paragraph and then takes some action based on what the level actually is:
Sub IsSelectionListParagraph()
Dim i As Integer
If Selection.Range.ListParagraphs.Count > 0 Then
For i = 1 To Selection.Range.ListParagraphs.Count
Select Case Selection.Range.ListParagraphs(i).Range.ListFormat.ListLevelNumber
Case Is = 1
Debug.Print Selection.Range.Text
Case Is = 2
Debug.Print Selection.Range.Text
Case Else
Debug.Print Selection.Range.Text
End Select
Next
End If
End Sub
Numbering is a ListParagraphs Object and can't be searched as if it's plain text.
i am attempting to write a macro that with find/replace a string and than move it to an existing heading. The original text is like this:
1. Heading 1
ID: abcd
1.1 Heading 2
ID: abcd
And it should look like:
1.Heading 1 abcd
1.1 Heading 2 abcd
I am having some problems with the code i tried to write, mostly because i am kinda new, but this is what i created so far:
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Style = "Heading 2"
With Selection.Find
.Text = "abcd"
.Replacement.Text = "abcd^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
The text is not so important because i managed to replace with what i want but i don't know how to align it with the Heading style.. Thanks
EDIT: I hope i don't screw up again, sorry big :). So i have raw which is the raw text and i want to process it to look like this final. I already found out, thanks to you how to replace the text, it's just that i stuck in the raw version. Thanks, I kinda own you a beer, or two
LATER EDIT: So i have 5 types of Heading formats, 1. Heading 1, 1.1 Heading 2 etc till 5, and all of them have below them an ID, each with a specific number, but the name is the same, ID ASD_PC_AWP_[XXXX]. I just have to get rid of ID ASD_PC_ and put AWP_[xxxx] at same level of the Heading eg: 1.Heading 1 AWP_[xxxx1] ** , **2. Heading 2 AWP_[xxx2]...
Try:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "ID:*^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Rng.End = Rng.Paragraphs.First.Range.End - 1
Rng.InsertAfter Split(Split(.Duplicate.Text, ":")(1), vbCr)(0)
.Text = vbNullString
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
Do a wildcard find for any paragraph marker which is followed by ID:.
.Text = "^13ID:"
.Replacement.Text = ""
You will need to specify the style of the replacement text to the heading style because when you delete the paragraph marker at the end of the Heading paragraph you will also delete the style information for the heading paragraph.
You will need to do this with every style heading followed by the ID: text.
Updated 2018-11-01
The following code should work. I got some hints from Macropods ingeneous code.
Update 2 2018-11-01
Revised to work with a list of styles defined by user at OPs request
Sub ConsolidateHeadingWithID()
Const HEADINGS As String = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Other style,another style"
Dim my_headings As Variant
Dim my_heading As Variant
my_headings = Split(HEADINGS, ",")
For Each my_heading In my_headings
With ActiveDocument.StoryRanges(wdMainTextStory)
With .Find
.ClearFormatting
.format = True
.Text = ""
.Style = my_heading
.MatchWildcards = True
.Wrap = wdFindStop
.Execute
End With
Do While .Find.Found
If .Duplicate.Next(unit:=wdWord).Text = "ID" Then
.Duplicate.Next(unit:=wdParagraph).Style = my_heading
End If
.Collapse wdCollapseEnd
.MoveStart unit:=wdCharacter, Count:=2
.Find.Execute
Loop
End With
With ActiveDocument.Range.Find
.ClearFormatting
.format = True
.Text = "(^13)(ID:)(*)(AWP_)([0-9]{1,})"
.Style = my_heading
.Replacement.Text = " [\4\5]"
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next
End Sub
I have a report that can be any where from 5 to hundreds of pages that provides patient information based upon lab tests. Each patient record is separated by underscores with a check box at the end. "___________|____|" Example:
LastName,First Patient Number Unit ANC 02 #### 2/23/2017 15:56
BLOOD
GLU-ANC 416 mg/dL H* REf. RAnge: 60-100 Critical 50-399
COMMENTS: Patient detail information and notes from the doctor show up
here and can be very flexible...
More clinical info etc.
_________________________________________________________________________|____|
LastName,First Patient Number Unit CH 1234 2/23/2017 15:56
SERUM
TROP I 54 mg/dL H* REf. RAnge: 60-100 Critical 50-399
COMMENTS: Patient detail information and notes from the doctor show up
here and can be very flexible...
More clinical info etc.
_________________________________________________________________________|____|
LastName,First Patient Number Unit ANC 1234 2/23/2017 15:56
FECES
FIT POSITIVE H* REf. RAnge: "NEG"-""60-100 Critical: REPORT
COMMENTS: Patient detail information and notes from the doctor show up
here and can be very flexible...
More clinical info etc.
_________________________________________________________________________|____|
If I find certain value, for example ANC or FIT in the patient record, I can skip these records when I review the printed report. So I want to replace the underscore check box with |SKIP|.
I can do this easily with a for next loop but the problem is I don't every know how many "ARTERIAL BLOOD" or "ANC" or "FECES FIT" that will show up on a given report. So I have been trying to figure out how to replace my For Next loop with a Do While Selection.Find.Execute = True statement.
But have tried many variations and cannot get the syntax right.
Any help would be greatly appreciated!
Here is my working For Next Loop
Sub xSimplefind()
Dim vtext As String
vtext = InputBox("Text to find") 'Here I enter 1st search value ie. "ANC"
For i = 1 To 7
With Selection.Find
.Execute FindText:=vtext
Selection.MoveRight Unit:=wdCharacter, Count:=1
End With
'Once I find that first item, I then look for the very next "|_____|"
With Selection.Find
.Execute FindText:="|____|" 'TypeText overwrites Selected text.
Selection.TypeText Text:="|SKIP|"
End With
Next i
End Sub
This isn't exactly what you need, but an example will hopefully set you on the right track:
Option Explicit
Sub MultiFind()
Dim valueToSkip() As String
valueToSkip = Split("ANC,FIT,ARTERIAL BLOOD,FECES FIT", Delimiter:=",")
Dim found As Boolean
Dim value As Variant
Dim result As Variant
found = False
For Each value In valueToSkip
With Selection.Find
Set result = .Execute(FindText:=value)
If Not result Is Nothing Then
found = True
Exit For
End If
End With
Next value
If found Then
'--- add |SKIP| here
End If
End Sub
This code works if anyone else needs to do something like this...
Thanks for the input and help from others!!
= = = = = Solution Found = = = = = = = = =
Sub test()
Dim vtext As Variant
For Each vtext In Array("Arterial", "ANC", "FIT", "PREVIOUS")
Selection.HomeKey Unit:=wdStory
'
'Inner loop to check every line
'
While True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = vtext
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Find
.Text = "|"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
If Selection.Text <> "|SKIP|" Then
Selection.Text = "|SKIP|"
Else
GoTo DoNextWord
End If
Wend
DoNextWord:
Next vtext
End Sub