Perfect! and thank you for allowing me to borrow from your genius.

"Mike H." wrote:

This would work:

Sub CreateNew()
Dim dataArray(5000, 5) As Variant
Dim x As Long
Dim Y As Long
Dim Fnd As Long
x = 2
Do While True
If Cells(x, 1).Value = Empty Then Exit Do
For Y = 5 To 8
If Cells(x, Y).Value < "" Then
Fnd = Fnd + 1
For Z = 1 To 4
dataarray(Fnd, Z) = Cells(x, Z)
Next
dataarray(Fnd, 5) = Cells(x, Y)
End If
Next
x = x + 1
Loop


Dim MyEntries As String
Workbooks.Add Template:="Workbook"
MyEntries = ActiveWorkbook.Name
Cells(1, 1) = "Client"
Cells(1, 2).Value = "Manager"
Cells(1, 3).Value = "Control#"
Cells(1, 4).Value = "Control Name"
Cells(1, 5).Value = "Code"
For x = 1 To Fnd
For Y = 1 To 5
Cells(x + 1, Y).Value = dataarray(x, Y)
Next
Next
Cells.Select
Cells.EntireColumn.AutoFit
Set PrtRng = Range(Cells(1, 1), Cells(Fnd + 2, 5))
With ActiveSheet.PageSetup
.Zoom = False
.PrintArea = PrtRng.Address
.PrintTitleRows = "$1:$1"
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 10
End With
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
ActiveWindow.SelectedSheets.PrintPreview


End Sub