Sequentially Numbering Labels

[Greg Maxey]

I have a project where I need to sequentially number labels, based on a
starting/ending number in a UserForm. The labels are 80 to a sheet (Avery
5267) and the numbers need to run down and across. I have managed to cobble
together some code that will do this as long as I only need one sheet of
labels.

When I need more than 80 labels I add rows to my label template, however
with my current code the numbering continues down to the second and
subsequent pages of labels before starting across. A simplified version of
the code is provided below.

Can anyone offer a suggestion on how I could modify my code so that the
numbering would go down 20 and across to fill the first page of labels then
down 20 and across to fill the second page, etc.

Sub CreateNumberedLabels()
Dim i As Long
Dim j As Long
Dim seqStart As Long
Dim seqEnd As Long
Dim rowsCount As Long
Dim pStr As String
seqStart = InputBox("Enter starting number")
seqEnd = InputBox("Enter ending number")
pStr = "Happy Valley VFD" & vbCr & "Ticket ###"
rowsCount = ((seqEnd - seqStart) \ 4) + 1
If rowsCount > 20 Then
For i = 21 To rowsCount
ActiveDocument.Tables(1).Rows.Add
Next i
End If
Application.ScreenUpdating = False
For i = 1 To 7 Step 2
For j = 1 To ActiveDocument.Tables(1).Rows.Count
ActiveDocument.Tables(1).Cell(j, i).Range.Text = _
Replace(pStr, "###", Format(seqStart, "00#"))
seqStart = seqStart + 1
Next j
Next i
Application.ScreenUpdating = True
End Sub




Thanks

 

[Greg Maxey]

Perhaps crude, but I think I found a suitable way to do this:

Basically I copy and paste the first page empty table to new sections for
each multiple of 80 labels. Then I process each table.

Any comments to improve or add efficiency will certainly be welcome.
Thanks.


Private Sub CommandButton1_Click()
Dim oTbl As Word.Table
Dim oRng As Word.Range
Dim tablesCount As Long
Dim labelCount As Long
Dim seqNum As Long
Dim x As Double
Dim i As Long
Dim j As Long
Dim seqStart As Long
Dim seqEnd As Long
Dim rowsCount As Long
seqStart = Me.TextBox3
seqEnd = Me.TextBox4
Set oTbl = ActiveDocument.Tables(1)
labelCount = (seqEnd - seqStart) + 1
tablesCount = labelCount / 80
x = labelCount / 80
If x - tablesCount < 0.5 Then tablesCount = tablesCount + 1
If tablesCount > 1 Then
For i = 2 To tablesCount
oTbl.Range.Copy
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseEnd
oRng.InsertBreak Type:=wdSectionBreakNextPage
ActiveDocument.Sections.Last.Range.Select
Selection.Paste
Next
End If
Set oTbl = Nothing
Application.ScreenUpdating = False
seqNum = 0
For Each oTbl In ActiveDocument.Range.Tables
For i = 1 To 7 Step 2
For j = 1 To 20
oTbl.Cell(j, i).Range.Text = _
Replace(Me.TextBox1.Text & vbCr & Me.TextBox2.Text, "##",
Format(seqStart, "00#"))
seqNum = seqNum + 1
seqStart = seqStart + 1
If seqNum = labelCount Then GoTo WrapUp
Next j
Next i
Next oTbl
WrapUp:
Me.Hide
Application.ScreenUpdating = True
End Sub