I have a table of several rows in my Word document. I want to search for a string in the table and when the string is found I want to add a new row below the string line. I wrote this code but its adding the new row after first row. I couldn't find where is the problem.
With ActiveDocument.Range
With .Tables(3).Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "LPC STAGE 2.3"
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then
MsgBox .Cells(1).RowIndex
End If
Loop
End With
Set rowNew = ActiveDocument.Tables(3).Rows.Add
Related
I am using Word VBA. I want to find a specific keyword "MyTest" from the beginning of the document, and then repeat until all of occurrences are found. How to do so?
I use macro record, and get the following codes:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "MyTest"
.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
This seems only start the find from the current position and will return one instance of the keyword?
The macro recorder will not give you the best code as it can only record what you do on screen. This means that it always works with the Selection object, i.e. whatever you have selected on screen.
Instead you should use a Range object set to the the part of the document you want to work with. Unless you are using ReplaceAll you also need to repeatedly execute the Find until you have found all the matches.
Below is a generic routine that you can modify.
Sub FindSomeTextAndDoSomething(textToFind As String)
Dim findRange As Range
Set findRange = ActiveDocument.Content
With findRange.Find
.ClearFormatting
.Text = textToFind
.Replacement.Text = ""
.Wrap = wdFindStop
.Format = False
Do While .Execute = True
'add code here to do something with the found text
'collapse range to continue
findRange.Collapse wdCollapseEnd
Loop
End With
End Sub
I want to delete a paragraph that starts with string "Page:" from the selection
Here is the sample text that I have:
Page: 28
Page: 44 contains a lot of example. But look up here for the detailed
explanation. This may go for more than one, two or three lines. This
totally depends upon the length of the text
Date: 10 Jan 2018
Some text goes here with Page: 108
I’ve some more text here
Few more
Final Text
Page: 208
This is the end
The code I have so far:
Sub DelPara()
Dim para As Paragraph
With Selection.Range.Find
.ClearFormatting
.Text = "[^13^11]Page:"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If (Selection.Range.Find = True) Then
para.Range.Delete
End If
End With
End Sub
The output should be
Date: 10 Jan 2018
Some text goes here with Page: 108
I’ve some more text here
Few more
Final Text
This is the end
The code below will search all instances of the search term in the current selection and delete the search term plus the entire paragraph in which the end of the term is located.
The key to this is using two Range objects: one for the original Range to be searched (the selection), the other for the actual search. In this way, the range that performs the actual search can be extended from the end of the last successful search to the end of the original range.
Sub DelPara()
Dim rngFind As Word.Range, rngSel As Word.Range
Dim para As Paragraph
Dim bFound As Boolean
Set rngSel = Selection.Range
Set rngFind = rngSel.Duplicate
With rngFind.Find
.ClearFormatting
.text = "[^13^11]Page:"
.Forward = True
.MatchWildcards = True
.wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
bFound = rngFind.Find.Execute
Do While bFound
rngFind.End = rngFind.paragraphs.Last.Range.End
rngFind.Delete
rngFind.Collapse wdCollapseEnd
rngFind.End = rngSel.End
bFound = rngFind.Find.Execute
Loop
End Sub
All you need is a wildcard Find/Replace with:
Find = ^13Page:[!^13]{1,}
Replace = nothing
No code required. At most, you might need to insert an empty paragraph at the beginning of the document and delete it afterwards - but then only if the first para starts with 'Page:'. Nevertheless, as a macro:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
.InsertBefore vbCr
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13Page:[!^13]{1,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
.Characters.First = vbNullString
End With
Application.ScreenUpdating = True
End Sub
If you want to process only the selected range, change 'ActiveDocument' to 'Selection'.
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
Looking to create a macro that will search down MS Word table, find a specific word, then move that entire row to the bottom of the table, then repeat for the next occurrence of that word.
The specs you've given # vbaexpress are somewhat different to what you gave here. Assuming the vbaexpress specs are correct, try:
Sub Demo()
Application.ScreenUpdating = False
Dim TblRng As Range, TmpRng As Range
With ActiveDocument.Tables(1)
Set TblRng = .Range: Set TmpRng = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "DENIED"
.Replacement.Text = ""
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If .InRange(TblRng) Then
TmpRng.Collapse wdCollapseEnd
TmpRng.FormattedText = .Rows(1).Range.FormattedText
.Rows(1).Delete
End If
.Find.Execute
Loop
End With
If .Rows.Count > TblRng.Rows.Count Then
.Split .Rows(TblRng.Rows.Count + 1)
End If
End With
Application.ScreenUpdating = True
End Sub
Note: the above code assumes you're processing just the first table in the document; if it's a different table, change the 1 in .Tables(1) to suit.
I have a Word table where I apply a routine that replaces paragraph marks with a comma and a space. However, in doing so there is now some text like '..., There...' and my client wanted to replace the Upper Case to Lower Case as much as possible.
So, I wrote some secondary code that I call from the previous routine as follows:
Sub LowerCaseAfterComma()
With Selection.Find
.ClearFormatting
.Text = ", ([A-Z])"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
While .Found
Selection.Range.Case = wdLowerCase
Selection.Collapse Direction:=wdCollapseEnd
.Execute
Wend
End With
End Sub
Although this identifies the instances of Upper Case characters in the table and replaces them accordingly, the code then looks for all other instances outside the table in the document, which I don't want the code to do. I have tried using the Range object in Word for the table I want edited but haven't been successful in the syntax needed.
NB. I have problems in ensuring the editing stays within the specific table. There can be a differing number of tables prior to the one I wish to edit so
ActiveDocument.Tables() specifying the number of the table doesn't seem to work.
I am sure I doing some basically wrong and the code just needs a little tinkering. However, I am just a novice developer learning.
Try
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Tables(1)
Set Rng = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ", ([A-Z])"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .InRange(Rng) Then
.Case = wdLowerCase
Else
Exit Do
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End With
Application.ScreenUpdating = True
End Sub