Selecting text between specific text and number

[bsward]

Hi,

This is my first post to these forums and VBA and thus apologise for posing what is probably a silly question.

I have a lengthy document which contains database output in an odd format. All lines take the form:

NUMBER TAG text
NUMBER TAG text


I want to write a macro which, for every line where the Tag is "start", to cut the text between that Tag and the next number which appears in a document. I then want to paste that text to the end of the line, exactly three lines up.

I have a basic structure for this but I have no real idea how to set the limit for the selection or even to append text three lines up. Any help, greatly appreciated.

Dim Tag as String
Tag = "X"
Selection.Find.ClearFormatting
With Selection.Find
.Text=Tag
.Forward=True
.MatchCase=True
End With

Now, how do I then make it select the required string after the Tag?

Many, many thanks,

Ben








Ben

[macropod]

Hi Ben,

When you say 'three lines up' are these single-line paragraphs, or something else? What is on those 'lines'? Can you post some representative data, showing the before/after views? Depending on what you're working with, a wildcard Find/Replace might do the job, without the need for any code.

[bsward]

Thanks for the suggestion. I suspect there may have been an easier or more efficient way to do it, but I was finally able to write something which solved it, and learnt a lot in the process.

The code I have created is:

Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Sub Titles()

Dim X As String

X = "NSFX"

Selection.HomeKey wdStory

With Selection.Find
.Text = X
.MatchCase = True
.MatchWholeWord = True
.Forward = True
End With

While Selection.Find.Execute

If Selection.Next(Unit:=wdWord, Count:=1) = "1 " Or Selection.Next(Unit:=wdWord, Count:=1) = "2 " Or Selection.Next(Unit:=wdWord, Count:=1) = "3 " Or Selection.Next(Unit:=wdWord, Count:=1) = "4 " Then
Selection.MoveRight Unit:=wdCharacter, Count:=2
GoTo d
Else
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If

a:
If Selection.Next(Unit:=wdWord, Count:=1) = "1 " Or Selection.Next(Unit:=wdWord, Count:=1) = "2 " Or Selection.Next(Unit:=wdWord, Count:=1) = "3 " Or Selection.Next(Unit:=wdWord, Count:=1) = "4 " Then
GoTo c
Else
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
GoTo a
End If

c:

' Commented-out lines are for cut of title instead of copy
' Selection.Cut
Selection.Copy
' Selection.InsertAfter Chr(11)

'Should really Check there are three lines here! but relying on fact that no 1-name individual currently has a title
Selection.MoveUp Unit:=wdLine, Count:=3
Selection.EndKey
Selection.TypeText ", "
Selection.Paste

OpenClipboard 0&
EmptyClipboard
CloseClipboard

' Selection.Delete wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=3
Selection.EndKey

d:

Wend

End Sub

Ben

[DanielHowden]

If you know the length of the item you need to get from the string you should try:-

Mid(string, start[, length])