Solved: X marks the spot

[blackie42]

Hi,

I have a long list of customers (and cheque details) that span most of a page.

The very first line of each of these records is a single X. What I'd like to be able to do is put each record on a seperate new page and replace the X with the next number - so each record gets a unique consecutive number

Be grateful for any help with this

thanks

Jon

[EricFletcher]

You can use Word's Find and Replace to insert an SEQ field to get the numbering, then convert the field codes to text to make them real numbers. Here's how.

It is easier to follow this if you turn on the view of non-printing characters (click the ? button) and make field codes visible (Tools Options, View; set Field codes Field shading: Always).

Replace your first X with SEQ /n, then select it and press Ctrl-F9 to make it into a field code. If you select it again and press F9, you'll see that it becomes a 1. Use Format Paragraph, Line and Page Breaks to turn on the "Page break before" setting. Copy the whole paragraph (1?).

Now use Find and Replace with "X^p" in the Find what box (no quotes); "^c" in the Replace with box; and Match Case checked (click More to see Match Case). The ^c represents "Clipboard contents" so when you click Replace All, each instance of a paragraph ending with X will be replaced by the field code and a paragraph end. (This is a key point to keep in mind later.)

Now select the entire document and update the field codes (Ctrl-A, F9) to show that each X is now a sequential number. One final step though... press Ctrl-Shift-F9 to convert the field codes to their results so you have real numbers in place. By setting the page break before to the paragraph containing the field code, each new entry will be on a page of its own.

A potential gotcha... as noted above, if a line elsewhere ends with "X", this procedure will put a sequence number in its place, so if a payee were, say, XEROX, it would create a problem. You could isolate it by using "^pX^p" in the Find what box so it would then only look for an X on a line by itself.

If you do this a lot, you could of course record a macro.

[blackie42]

Wow - what a description - thanks - I'll give it a go

regards

Jon

[Tinbendr]

Jon, If that doesn't work for you , try this.

Option Explicit
Sub XMarksTheSpot()
Dim ListDoc As Document
Dim aDoc As Document
Dim bDoc As Document
Dim AllRng As Range
Dim aRng As Range
Dim bRng As Range
Dim cRng As Range
Dim FName As String
Dim Counter As Integer
'ListDoc is this document.
'We'll use it to track our processes.
Set ListDoc = ActiveDocument
'Since you recieve the file monthly, you'll
'most likely want to keep this macro in a
'seperate document and simply point to the
'recieved file for processing.
With Dialogs(wdDialogFileOpen)
If .Show Then
Application.ScreenUpdating = False
Set aDoc = Documents.Open(.Name, Visible:=False)
Else
End
End If
End With
Set AllRng = aDoc.Range
Set aRng = AllRng.Duplicate
Set bRng = AllRng.Duplicate
Do
'Find first occurance
aRng.Find.Execute findtext:="X" & "^p"
If aRng.Find.Found Then
'Counter for number of records
Counter = Counter + 1
FName = Format(Date, "YYMMDD-") & Format(Counter, "0000")
aRng.Text = FName & vbCr
bRng.Start = aRng.End + 1
bRng.Find.Execute findtext:="X" & "^p"
'same thing for the next record
If bRng.Find.Found Then
Set cRng = aDoc.Range(aRng.Start, bRng.Start)
Call SetUpNewDoc(bDoc, cRng, FName)
ListDoc.Range.InsertAfter FName & vbCr
Else
Set cRng = aDoc.Range(aRng.Start, AllRng.End)
Call SetUpNewDoc(bDoc, cRng, FName)
ListDoc.Range.InsertAfter FName & vbCr
End If
'This redefines the search range.
aRng.Start = aRng.End + 1
aRng.End = AllRng.End
End If
Loop Until Not aRng.Find.Found
aDoc.Close savechanges:=wdDoNotSaveChanges
Application.ScreenUpdating = True
Application.ScreenRefresh
End Sub
Sub SetUpNewDoc(bDoc As Document, cRng As Range, FName As String)
Set bDoc = Documents.Add(Visible:=False)
With bDoc.PageSetup
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
End With
bDoc.Range.FormattedText = cRng.FormattedText
bDoc.SaveAs FName
bDoc.Close savechanges:=wdDoNotSaveChanges
End Sub

[blackie42]

Thanks very much for the code TinBendr - it works very well. I may have misled you because the code creates separate documents for each cheque - what I wanted was to have it all on one document and just separate pages.

Would you mind adjusting the code as I'm having trouble deciphering it (most of the VBA stuff I've done is with excel and I'm only a novice really)

thanks again

[fumei]

If you do not want to use SEQ (although using it is very handy), and you find Tinbendr's code a bit.....complex, you can use:
Sub Alternative()
Dim r As Range
Dim j As Long
j = 1
Set r = ActiveDocument.Range
With r.Find
Do While .Execute(FindText:="X", Forward:=True) _
= True
If r.Next = vbCr Or r.Next = vbCrLf Then
Select Case j
Case 1
r.Text = j
Case Else
With r
.Text = j
.Collapse Direction:=wdCollapseStart
.InsertBreak Type:=wdPageBreak
.Move Unit:=wdCharacter, Count:=2
End With
End Select
j = j + 1
End If
r.Collapse 0
Loop
End With
End Sub



as it does not use (or need) any of those extraneous variables. Only one range and one Long is needed. You do not need to use Duplicate or the other ranges and counting yadda yadda.

Demo attached. Just click "Alternative" on the top toolbar.

BTW: you could easily replace the number (1, 2, 3...) with something like:

Client: number

or any other text. Just replace where I use j, with something like:


r.Text = "Client yadda" & j

[blackie42]

Yep - works very well - thanks again to all contributors.

regards

Jon