VB Word - Find/select if

[george hart]

Hi

This code looks for text "P/Car" jumps to the left of it and deletes certain data below.

What I need however, is for the code find "P/Car", select the text below it and delete it by scrolling down the text untill it = "".

I guess the "Count:=21," needs changing but I dont know how???


WordApp.Activate
WordApp.Selection.Find.ClearFormatting
With WordApp.Selection.Find
.Text = "P/Car"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
WordApp.Selection.Find.Execute
WordApp.Selection.MoveLeft Unit:=wdWord, Count:=1
WordApp.Selection.MoveDown Unit:=wdLine, Count:=1
WordApp.Selection.MoveRight Unit:=wdWord, Count:=11, Extend:=wdExtend
WordApp.Selection.MoveDown Unit:=wdParagraph, Count:=21, Extend:=wdExtend
WordApp.Selection.Delete Unit:=wdCharacter, Count:=1
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
Placement:=wdInLine, DisplayAsIcon:=False

 

[Macropod]

Hi George,

If you can post some representative data showing what it is you're searching for and what you're trying to delete, it might be possible to specify it as a wildcard Find/Replace - without the need for vba.

 

[george hart]

Many thanks for your response.

This has now been resolved as below:

Dim WordApp As Object
Dim wrdDoc As Object
Dim tmpDoc As Object
Dim WDoc As String
Dim myDoc As String
Dim StartWord As String, EndWord As String
StartWord = "Work"
EndWord = "Location of spare Power Cars"
myDoc = "HSS Fleet Report 0500"
WDoc = ThisWorkbook.Path & "\" & myDoc & ".doc"
Set WordApp = GetObject(, "Word.Application")
'Excel copy data
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
WordApp.Activate

With WordApp.ActiveDocument.Content.Duplicate
.Find.Execute Findtext:=StartWord & "*" & EndWord, MatchWildcards:=True
.MoveStart wdCharacter, Len(StartWord)
.MoveEnd wdCharacter, -Len(EndWord)
.Font.Bold = False
.Select
WordApp.Selection.Delete Unit:=wdCharacter, Count:=1
WordApp.Selection.TypeParagraph
WordApp.Selection.TypeParagraph
WordApp.Selection.TypeParagraph
WordApp.Selection.MoveUp Unit:=wdLine, Count:=2
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
Placement:=wdInLine, DisplayAsIcon:=False

End With
End Sub

 

[Macropod]

Hi George,

As I said, if you described what you were trying to do, I'm sure help could have been given. Whilst you may feel the issue is resolved, the code you've posted is far from optimal.

 

[george hart]

Many thanks

I appreciate the code isn't perfect although I am a novice...After lots of testing the code seems to work fine.