Search for particular strings and then cut and paste with formatting

[Shaolin666]

Hi,

I have a word document with hundreds of pages and thousands of paragraphs. The paragraphs all conform to the same format of a reference number followed by a date and a title in quotations all in parenthesis, followed by a passage of text i.e.

456 (M 21-09-15 "Title here") Passage of text starts here.

457 (T 22-09-15 "another title here") Another different passage of text here of differing length.

458 (T 24-09-15 "yet another title here") Another passage starts here.

How would I go about reformatting this via vBA such that it is now represented in the following format, stripping out the letter M,T,W,T,F,S,S for days of the month and also bolding the headings:

Title Name: Title here
Reference: 456
Date: 2015-09-21


Passage: Passage of text starts here.

Title Name: another title here
Reference: 457
Date: 2015-09-22


Passage: Another different passage of text here of differing length.


Title Name: yet another title here
Reference: 458
Date: 2015-09-24


Passage: Another passage starts here.


Any help appreciated.

Kind regards

Shaolin666

[gmayor]

The following macro will do that for your document sample, assuming each line is a paragraph

Sub Macro1()
Dim oRng As Range, oPara As Range
Dim oRng2 As Range
Dim oNewPara As Paragraph
Dim strText1 As String
Dim strText2 As String
Dim strText3 As String
Dim strText4 As String
Dim strNewText As String
Dim i As Long

For i = ActiveDocument.Range.Paragraphs.Count To 1 Step -1
Set oPara = ActiveDocument.Range.Paragraphs(i).Range
If Len(oPara) > 1 Then
Set oRng = oPara
oRng.MoveStart , 16
oRng.Collapse 1
oRng.MoveEndUntil ")"
strText1 = oRng.Text

Set oPara = ActiveDocument.Range.Paragraphs(i).Range
Set oRng = oPara
strText2 = Left(oRng.Text, 3)
If Not IsNumeric(strText2) Then GoTo Skip
oRng.Start = oPara.Start
oRng.MoveStart , 7
oRng.End = oRng.Start + 8
strText3 = oRng.Text

Set oPara = ActiveDocument.Range.Paragraphs(i).Range
Set oRng = oPara
oRng.MoveStartUntil ")"
oRng.Start = oRng.Start + 2
strText4 = oRng.Text

strNewText = "Title Name: " & strText1 & vbCr & _
"Reference: " & strText2 & vbCr & _
"Date: " & strText3 & vbCr & vbCr & _
"Passage: " & strText4

Set oPara = ActiveDocument.Range.Paragraphs(i).Range
oPara.Text = strNewText
For Each oNewPara In oPara.Paragraphs
Set oRng2 = oNewPara.Range
oRng2.Collapse 1
oRng2.MoveEndUntil ":"
oRng2.End = oRng2.End + 1
oRng2.Font.Bold = True
Next oNewPara
End If
Skip:
Next i
lbl_Exit:
Exit Sub
End Sub

[Shaolin666]

That worked perfectly.

THANK YOU