Solved: Delete everything but

[blackie42]

Hi,

Hoping someone can help with the following annoyance.

I have a report that lists a (big) number of customers. I want to keep a certain group of customers details and delete everything else using a macro as it a big chore using find and then editing. Each record is seperated by a space. The records i want to keep are 3 lines each and the last line has a G in brackets only as the first character.

e.g (underscore is a space)

1235_6789_Cust1__23.56_56.526____more numbers
(Active)
(G)
Line
2565_5564_Cust2__25.63_52.236____more numbers
(Active)
Line
1254_5648_Cust3__24.56_256.321___more numbers
(Active)
Line
4251_5698_Cust4__12.35_14.256____more numbers
(Active)
(G)

Just want to keep the records witha (G) on 3rd record line

Any help very appreciated

thanks

Jon

[Tinbendr]

This assumes the line seperator is a paragraph mark.

Sub Seperate_G_Records()
Dim aDoc As Document
Dim bDoc As Document
Dim AllRng As Range
Dim SrchRng As Range
Set aDoc = ActiveDocument
Set bDoc = Documents.Add
Set AllRng = aDoc.Range
Set SrchRng = AllRng.Duplicate
Do
SrchRng.Find.Execute findtext:="(G)", Wrap:=wdFindStop
If SrchRng.Find.Found Then
SrchRng.MoveStart wdParagraph, -2
SrchRng.MoveEnd wdParagraph, -2
bDoc.Range.InsertAfter SrchRng.Text
SrchRng.MoveStart wdParagraph, 3
SrchRng.End = AllRng.End
Application.StatusBar = "Approx " & Format((SrchRng.Start _
/ AllRng.End) * 100, "##") & "% complete"
End If
Loop Until Not SrchRng.Find.Found
End Sub

[blackie42]

Thanks very much for your reply (I am not familiar with word VBA and only a novice/intermediate at Excel)

The record separator is actually a blank row? I ran the code and it did seem to pick out some records but the format was also incorrect. I have attached a couple of pages from the report

Would be grateful for any more help you can give me.

thanks

Jon

[blackie42]

Hi again,

I would like to keep the whole record as well ie all 3 lines.

thanks

[Tinbendr]

Sub Seperate_G_Records()
Dim aDoc As Document
Dim bDoc As Document
Dim AllRng As Range
Dim SrchRng As Range
Set aDoc = ActiveDocument
Set bDoc = Documents.Add
'easier to read in landscape
With bDoc.PageSetup
.Orientation = wdOrientLandscape
End With

Set AllRng = aDoc.Range
Set SrchRng = AllRng.Duplicate
Do
SrchRng.Find.Execute findtext:="(G)", Wrap:=wdFindStop
If SrchRng.Find.Found Then
SrchRng.MoveStart wdParagraph, -2
bDoc.Range.InsertAfter SrchRng.Text & vbCr
SrchRng.MoveStart wdParagraph, 3
A = SrchRng.Start
SrchRng.End = AllRng.End
Application.StatusBar = "Approx " & Format((SrchRng.Start _
/ AllRng.End) * 100, "##") & "% complete"
End If
Loop Until Not SrchRng.Find.Found

'set font
Set AllRng = bDoc.Range
With AllRng.Font
.Name = "Courier New"
.Size = 8
End With
End Sub

[blackie42]

Thanks very much - works a treat.

regards

Jon:thumb