Copy text in a document with anchor

[dzogchen]

Good morning!

I'm trying to develop a sub routine where I need to copy the next word whenever appears "Modelo:", example:

Modelo: OPTIFLUX 2100 C
The text I need to copy is "OPTIFLUX 2100 C", there is a tab between "Modelo:" and "OPTIFLUX 2100 C".

The code I develop is:



Sub Chipita_kok(W, V, Y, Z, x, New1)
Dim Modelo1 As String

New1 = ""
Modelo1 = ""

W = Selection.Information(wdActiveEndPageNumber)
Z = Selection.Information(wdVerticalPositionRelativeToPage)

On Error Resume Next

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Modelo:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
Modelo1 = Selection
V = Selection.Information(wdActiveEndPageNumber)
If Left(Modelo1, 9) = "IFC 100 W" Or Left(Modelo1, 9) = "IFC 100 C" Or Left(Modelo1, 9) = "IFC 070 C" Or Left(Modelo1, 9) = "IFC 070 F" Or Left(Modelo1, 9) = "IFC 050 C" Or Left(Modelo1, 9) = "IFC 050 W" Or Left(Modelo1, 13) = "Optiflux 2000" Or Left(Modelo1, 5) = "V/Ref" Or Left(Modelo1, 13) = "Optiflux 1000" Then
Modelo1 = ""
If V = "" Then GoTo Fomes
Selection.EndKey Unit:=wdLine
x = Selection.Information(wdVerticalPositionRelativeToPage)
Y = Selection.Information(wdVerticalPositionRelativeToPage)

Else
New1 = Modelo1
End If

Fomes:

Y = Selection.Information(wdVerticalPositionRelativeToPage)
Selection.EndKey Unit:=wdLine
'Selection.MoveDown Unit:=wdLine, Count:=5

End Sub



It becames more complex when I need to avoid some text just like "IFC 100 W", "IFC 100 C", "IFC 070 C", (...)

The state of the art for this routine is when appers a table just like:



Qde
Diâmetro/Flanges


5
DN25 PN40


1
DN32 PN40


8
DN40 PN40


2
DN50 PN40


3
DN65 PN16


6
DN80 PN40


1
DN100 PN16





the variable Modelo1 must be is equal to "OPTIFLUX 2100 C" as many the "Qde" times, for this table 7 times. Note: the tables appears sometimes.

Is this possible in VBA?

Any help will be much appreciated!

Best regards

Nuno

[gmayor]

The part of your question
I'm trying to develop a sub routine where I need to copy the next word whenever appears "Modelo:", example:

Modelo: OPTIFLUX 2100 C
The text I need to copy is "OPTIFLUX 2100 C", there is a tab between "Modelo:" and "OPTIFLUX 2100 C".is fairly straightforward. The rest of your question is incomprehensible.
For a start you have asked for the next 'word' after "Modelo:" and yet your example has three words and there is no context in relation to what else is in the document or how it is formatted?
How for example would a macro know when the required string ended? The next word would be OPTIFLUX which is easy, but how is the macro to know that you want 2100 or 2100 C also?

You have a list of things to exclude, but what do you want to do with those words that are not excluded when they are found?

[dzogchen]

Hello gmayor,

Sorry if I wasn't clear enought!

Yes you are right, in the example I gave "Optiflux 2100 C" it is three words in fact. What I want to do is to copy to the end of the line next to "Modelo:", it could be one word or more, this is what this routine do


Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
Modelo1 = Selection







You have a list of things to exclude, but what do you want to do with those words that are not excluded when they are found?


When the selection is different of "IFC 100 W", "IFC 100 C", "IFC 070 C", (...) a variable must have the same value of the selection.


Can I help to clarify other questions?

Regards

[gmayor]

You still haven't said what you want to do with these found items, however the basic code to find them (omitting those you listed) is as follows, assuming that by 'Line' you mean 'Paragraph'


Sub Macro1()Dim oRng As Range
Const strFind As String = "Modelo:^t"
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:=strFind)
oRng.Collapse 0
oRng.End = oRng.Paragraphs(1).Range.End - 1
If Not Left(oRng.Text, 9) = "IFC 100 W" Or _
Not Left(oRng.Text, 9) = "IFC 100 C" Or _
Not Left(oRng.Text, 9) = "IFC 070 C" Or _
Not Left(oRng.Text, 9) = "IFC 070 F" Or _
Not Left(oRng.Text, 9) = "IFC 050 C" Or _
Not Left(oRng.Text, 9) = "IFC 050 W" Or _
Not Left(oRng.Text, 13) = "Optiflux 2000" Or _
Not Left(oRng.Text, 5) = "V/Ref" Or _
Not Left(oRng.Text, 13) = "Optiflux 1000" Then
'do what you want with oRng here e.g.
MsgBox oRng.Text
End If
oRng.Collapse 0
Loop
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

[dzogchen]

You still haven't said what you want to do with these found items, however the basic code to find them (omitting those you listed) is as follows, assuming that by 'Line' you mean 'Paragraph'

The Objective is to put that found items in a Microsoft Office Spreadsheet 11.0 which is in a userform


Thank you gmayor!

[gmayor]

The following will add the found items to an array and you can write that array to a worksheet as shown

Sub Macro1()
Dim arrList() As String
Dim oRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim NextRow As Integer, i As Integer
Const strFind As String = "Modelo:^t"
Set oRng = ActiveDocument.Range
ReDim arrList(0)
With oRng.Find
Do While .Execute(FindText:=strFind)
oRng.Collapse 0
oRng.End = oRng.Paragraphs(1).Range.End - 1
If Not Left(oRng.Text, 9) = "IFC 100 W" Or _
Not Left(oRng.Text, 9) = "IFC 100 C" Or _
Not Left(oRng.Text, 9) = "IFC 070 C" Or _
Not Left(oRng.Text, 9) = "IFC 070 F" Or _
Not Left(oRng.Text, 9) = "IFC 050 C" Or _
Not Left(oRng.Text, 9) = "IFC 050 W" Or _
Not Left(oRng.Text, 13) = "Optiflux 2000" Or _
Not Left(oRng.Text, 5) = "V/Ref" Or _
Not Left(oRng.Text, 13) = "Optiflux 1000" Then
ReDim Preserve arrList(UBound(arrList) + 1)
arrList(UBound(arrList)) = oRng.Text
End If
oRng.Collapse 0
Loop
End With
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Add
xlBook.Sheets(1).Cells(1, 1).value = "Modelo"
xlApp.Visible = True
For i = 0 To UBound(arrList)
NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
xlBook.Sheets(1).Cells(NextRow, 1).value = arrList(i)
Next i
lbl_Exit:
Set oRng = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Exit Sub
End Sub

[dzogchen]

Sorry gmayor for the late reply, I was out of the country in vacations.

What I intend to do is to put those found words in a userform textbox.

Based on the last code you posted i developed the following code that works better for what I intend to do:


Sub Macro99()
Dim oRng As range
Const strFind As String = "Modelo:^t"

Set oRng = ActiveDocument.range
With oRng.Find
Do While .Execute(FindText:=strFind)
oRng.Collapse 0
oRng.End = oRng.Paragraphs(1).range.End - 1

If Left(oRng.Text, 9) = "IFC 100 W" Or _
Left(oRng.Text, 9) = "IFC 100 C" Or _
Left(oRng.Text, 9) = "IFC 070 C" Or _
Left(oRng.Text, 9) = "IFC 070 F" Or _
Left(oRng.Text, 9) = "IFC 050 C" Or _
Left(oRng.Text, 9) = "IFC 050 W" Or _
Left(oRng.Text, 9) = "IFC 300 W" Or _
Left(oRng.Text, 9) = "MAC 100" Or _
Left(oRng.Text, 17) = "OPTISENS ODO 2000" Or _
Left(oRng.Text, 13) = "Optiflux 2000" Or _
Left(oRng.Text, 17) = "SMARTPAT ORP 1590" Or _
Left(oRng.Text, 16) = "Waterflux 3000 F" Or _
Left(oRng.Text, 13) = "Optiflux 1000" Or _
Left(oRng.Text, 15) = "Optiflux 2000 F" Then
GoTo 1
End If
MsgBox oRng.Text
1:
oRng.Collapse 0
Loop
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

Just one more question: Could we find more than one word?