I'm using Range.Find to find a specific string in a document. When I find this string I want to look at the character BEFORE this string. I had an idea to get the range as selection and then use the Selection.MoveLeft = 1 but I really can't find how to get the range as selection. This is the code I have:
Private Function abc() As Boolean
Set rng = ActiveDocument.Range
With rng.Find
.MatchWildcards = True
Do While .Execute(findText:="123456", Forward:=False) = True
MsgBox (rng.Text)
Set Selection = rng 'Set the selection from range
MsgBox (Selection.Text)
Selection.MoveLeft = 1 'Move the selection
MsgBox (Selection.Text)
Loop
End With
abc = True
End Function
Solution
Here is my solution.
Sub testhis()
Set rng = ActiveDocument.Range
With rng.Find
.MatchWildcards = True
Do While .Execute(findText:="123456", Forward:=False) = True
rng.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=2
MsgBox (Selection.Text)
Loop
End With
End Sub
Hope this helps.
Here's a way you can do it without Selecting
Sub abc()
Dim rng As Range
Set rng = ActiveDocument.Range
With rng.Find
.MatchWildcards = True
Do While .Execute(findText:="123456", Forward:=False) = True
MsgBox rng.Text
rng.Move wdCharacter, -2
rng.Expand wdCharacter
MsgBox rng.Text
Loop
End With
End Sub
Related
I am trying to select a range between two words, find a word within the found range and finally color that word.
In the image I want to select range between "Observation" and "Supporting Information" and then search for "Management" words and color them red.
With my code I am able to highlight the first occurrence of the word.
Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Observation:") Then
Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
If rng2.Find.Execute(FindText:="Supporting Information:") Then
Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
If rngFound.Find.Execute(FindText:="Management") Then
rngFound.Select
Selection.Range.HighlightColorIndex = wdRed
End If
End If
End If
Selection.HomeKey wdStory
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
A modified version of your code using Find to highlight the text.
Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim highlightIndex As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'capture current highlight color so that it can be reset later
highlightIndex = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdRed
Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Observation:") Then
Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
If rng2.Find.Execute(FindText:="Supporting Information:") Then
Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
With rngFound.Find
.Replacement.highlight = True
.Execute Replace:=wdReplaceAll, Forward:=True, FindText:="Management", ReplaceWith:="", Format:=True
End With
End If
End If
Options.DefaultHighlightColorIndex = highlightIndex
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The Find method in word can be a bit tricky to manage. What you want to achieve must be done with two searches inside a loop. The first search finds the next 'Observation:', the Second Finds the following 'Supporting Information:'. You then use the end of the first search and the start of the second search to generate the range that needs to be made 'wdRed'
The following code works well on my PC
Option Explicit
Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Dim myOuterRange As Word.Range
Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
With myOuterRange
Do
With .Find
.ClearFormatting
.MatchWildcards = True
.Text = "(Observation)([: ]{1,})(^13)"
.Wrap = wdFindStop
If Not .Execute Then Exit Do
End With
Dim mystart As Long
mystart = .End
.Collapse direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
With .Find
.ClearFormatting
.MatchWildcards = True
.Text = "^13Supporting Information"
.Wrap = wdFindStop
If Not .Execute Then Exit Do
End With
Dim myEnd As Long
myEnd = .Start
ActiveDocument.Range(mystart, myEnd).Font.ColorIndex = wdRed
.Collapse direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
Loop
End With
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub
UPDATE
This is the code I first wrote. I blame a biscuit (cookie) shortage for misreading the post the second time and revising my code to the first provided.
Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Dim myOuterRange As Word.Range
Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
With myOuterRange
Do
With .Find
.ClearFormatting
.MatchWildcards = True
.Text = "(Observation:)(*)(Supporting Information:)"
.Wrap = wdFindStop
If Not .Execute Then Exit Do
End With
Dim myInnerRange As Word.Range
Set myInnerRange = .Duplicate
With myInnerRange
With .Find
.Text = "Management"
.Replacement.Font.ColorIndex = wdRed
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
End With
.Collapse Direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
Loop
End With
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub
I am trying to move all the text I have in parenthesis to a comment in a range I select. I am almost there but for some reason it only works at the start of the range. My macro is as follows:
Sub CommentOutParenthsLocal()
'
' CommentBubble Macro
'
'
Dim myRange As Range
Set myRange = Selection.Range
searchText = "\(*\)"
With myRange.Find
.MatchWildcards = True
Do While .Execute(findText:=searchText, Forward:=True) = True
ActiveDocument.Comments.Add myRange, myRange.Text
myRange.Text = ""
Loop
End With
End Sub
Any advice?
Based on your description, you need to limit your code's scope to what you've actually selected, amongst other things. In that case, try:
Sub CommentOutParenthsLocal()
Application.ScreenUpdating = True
Dim myRange As Range
Set myRange = Selection.Range
With Selection.Range
With .Find
.Text = "\(*\)"
.Forward = True
.MatchWildcards = True
.Execute
End With
Do While .Find.Found = True
If .InRange(myRange) = False Then Exit Do
.Comments.Add .Duplicate, .Text
.Text = vbNullString
.Find.Execute
Loop
End With
Application.ScreenUpdating = False
End Sub
I have to run the three macros with single click, when i call the first macro the selected word got reversed but the selection got lost and i think the selection got deselected due to the change of the word(in reversed), but i need the selection to run the other macros on the same selection.
Dim oWord As Range
If Selection.Information(wdWithInTable) = True Then
For Each cl In Selection.Cells
Set rng = cl.Range
rng.MoveEnd Word.WdUnits.wdCharacter, Count:=-1
For i = 1 To rng.Words.Count
Set iRng = rng.Words(i)
'rng.Select
Set oWord = iRng
Do While oWord.Characters.Last.Text = " "
Call oWord.MoveEnd(WdUnits.wdCharacter, -1)
Loop
Debug.Print "'" & oWord.Text & "'"
oWord.Text = StrReverse(oWord.Text)
Debug.Print Selection.Text
Next i
Next cl
End If
End Sub
Sub Align()
'Selection.RtlPara
Selection.LtrPara
End Sub
Private Sub CommandButton2_Click()
Call Align
Call CommandButton1_Click
Call Comma_Remove
Call CommandButton1_Click
End Sub
Sub Comma_Remove()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ","
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
This picture illustrates the issues i received after changes to the code
I amended your code to show you what I mean. I added the SelectedRange variable. Selected range uses duplicate to make a copy of the selection range. SelectedRange is set as a global variable for the purposes of your code. localRange is used in your macros where we make a copy of SelectedRange.
Edit 2018-12-20: Minor updates to the code to add option explicit, add missing declarations, make SelectedRange global and to replace the mysterious LtlPara with code to left align paragraphs
Edit 2018-12-21: revised code to reestablish selection and an explanation of why this is necessary.
The OP is selecting a range of cells in a table and then iterating over the cells to do a couple of transformations on the string in each cell. Typically we would not use selection for all of these operations, instead we would set a word range and work with the word range. In this specific case this runs into a problem because there is a difference between Selection and a word range when applied to a table. The difference is that Selection.Cells.Count gives the number of of cells in the selection but selection.Range.Cells.count gives the number of cells in the table starting with the first cell in Selection.range, counting each cell in the table from left to right, row by row, until the last cell in the selection is reached. This is why cells not in the selection are being processed when using a word range rather than the selection.
We can overcome this oddity by preserving the selection range in a word range and then restoring the selection using SelectedRange.Select for each sub that needs to work on the Selection.
Option Explicit
Public SelectedRange As Word.Range
Private Sub CommandButton1_Click()
Dim cl As Word.Cell
Dim Rng As Word.Range
Dim i As Long
Dim iRng As Word.Range
Dim oWord As Word.Range
SelectedRange.Select
If Selection.Information(wdWithInTable) = True Then
For Each cl In Selection.Cells
Set Rng = cl.Range
Rng.MoveEnd Word.WdUnits.wdCharacter, Count:=-1
For i = 1 To Rng.Words.Count
Set iRng = Rng.Words(i)
'rng.Select
Set oWord = iRng
Do While oWord.Characters.Last.Text = " "
Call oWord.MoveEnd(WdUnits.wdCharacter, -1)
Loop
Debug.Print "'" & oWord.Text & "'"
oWord.Text = StrReverse(oWord.Text)
Debug.Print Selection.Text
Next i
Next cl
End If
End Sub
Sub Align()
Dim localrange As Word.Range
'Set localrange = SelectedRange.Duplicate
SelectedRange.Select
'Selection.RtlPara
Selection.Paragraphs.Alignment = wdAlignParagraphLeft
End Sub
Private Sub CommandButton2_Click()
Set SelectedRange = Selection.Range.Duplicate 'make a copy of the selection range
Align
CommandButton1_Click
Comma_Remove
CommandButton1_Click
End Sub
Sub Comma_Remove()
SelectedRange.Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ","
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
I want to create a macro, which will allow to select entire code blocks in the document.
This is what I currently have:
Sub SelectSnippet()
Selection.Find.Style = ActiveDocument.Styles("Code")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub
The problem is, that it selects only the next line of code, instead of snippet entirely.
Visually:
This code should do the job. Please try.
Sub SelectSnippet()
Dim Styl As Variant
Dim Rng As Range
Dim Fnd As Boolean
Styl = "Code"
Set Rng = Selection.Range ' start at the selection
' find the nearest different style before the selection
With Rng
Do While .Start > 1
If .Style <> Styl Then Exit Do
.Move wdCharacter, -1
Loop
End With
' look for the first occurrance of the style
On Error Resume Next
With Rng.Find
.Text = ""
.Style = Styl
Fnd = .Execute
End With
If Err Then
MsgBox Err.Description, vbInformation, "Can't find """ & Styl & """"
End If
If Fnd Then
' expand the range to the end of the style
With Rng
Do While .End < .Document.Characters.Count
If .Document.Range(.End, .End + 1).Style <> Styl Then Exit Do
.MoveEnd wdCharacter, 1
Loop
.Select ' select the range
End With
End If
End Sub
The following code does the same job but looks at complete paragraphs only. If a part of a paragraph isn't of the same style it may or may not be included.
Sub NewSelectSnippet()
Dim Styl As Variant
Dim Rng As Range
Dim DocRng As Range
Dim p As Integer
Styl = "Code"
' expand the section to include the entire paragraph
Set Rng = Selection.Paragraphs(1).Range
If Rng.Style <> Styl Then Exit Sub
' expand the range to include preceding paragraphs of same style
Set DocRng = ActiveDocument.Range(0, Rng.End)
With DocRng.Paragraphs
For p = .Count To 1 Step -1
If .Item(p).Range.Style = Styl Then
Rng.MoveStart wdParagraph, -1
Else
Exit For
End If
Next p
End With
' expand the range to include following paragraphs of same style
With ActiveDocument.Paragraphs
For p = (DocRng.Paragraphs.Count + 1) To .Count
If .Item(p).Range.Style = Styl Then
Rng.MoveEnd wdParagraph, 1
Else
Exit For
End If
Next p
End With
Rng.Select
End Sub
While working in Range of another document TCN.docx I am getting Error of method or data member not found on rng.MoveRight unit:=Cell position.
Sub TNC()
Dim odoc As Document
Dim rng As Word.Range
Set odoc = Documents.Open(filename:="C:\Users\Bilal\Desktop\TCN.docx", Visible:=True)
Set rng = odoc.Content
rng.Find.ClearFormatting
rng.Find.Font.Bold = True
With rng.Find
.Text = "BU"
.Forward = True
.Wrap = wdFindStop
.Format = True
End With
rng.Find.Execute
If rng.Find.Found = True Then
rng.MoveRight unit:=Cell **ERROR position**
rng.COPY
Else
End If
odoc.Close wdDoNotSaveChanges
Selection.PasteAndFormat (wdPasteDefault)
End Sub
for better understanding
edited: after question editing by Cindy Meister
MoveRight is not a valid method for Range object while it is for Selection object
and there's no Cell value for unit enumeration, while wdCell is
to copy the element one cell to the right of the found one, use
...
rng.Find.Execute
If rng.Find.Found = True Then
rng.Select
Selection.MoveRight unit:=wdCell
Selection.Copy
Else
End If
...