I have a spreadsheet in which columns E - I are references to column C and
may or may not contain data (one to one or one to many). I would like to
insert a new row, copying the data in A - D for each time there is data
contiained in columns E - I.

ex. (Would want to see as three rows for data in E, F and I)
A B C D E F
G H I
Client Manager Control# Control Name Code1 Code2 Blank Blank
Code3

Do you want the old rows and then the new rows or do you want old row, old
row, then if old row has something in E-I, new rows inserted right there or
placed at the bottom of the existing data? Or do you just want the new rows
or the old rows if no new rows are made?

"JC" wrote:

I have a spreadsheet in which columns E - I are references to column C and
may or may not contain data (one to one or one to many). I would like to
insert a new row, copying the data in A - D for each time there is data
contiained in columns E - I.

ex. (Would want to see as three rows for data in E, F and I)
A B C D E F
G H I
Client Manager Control# Control Name Code1 Code2 Blank Blank
Code3

I would want new rows. The old row would not be needed once the data from
columns E - I was transposed (new column) into the new rows. There will
always be at least one of those cells with data (always one to one or one to
many; never one to none).

"Mike H." wrote:

Do you want the old rows and then the new rows or do you want old row, old
row, then if old row has something in E-I, new rows inserted right there or
placed at the bottom of the existing data? Or do you just want the new rows
or the old rows if no new rows are made?

"JC" wrote:

I have a spreadsheet in which columns E - I are references to column C and
may or may not contain data (one to one or one to many). I would like to
insert a new row, copying the data in A - D for each time there is data
contiained in columns E - I.

ex. (Would want to see as three rows for data in E, F and I)
A B C D E F
G H I
Client Manager Control# Control Name Code1 Code2 Blank Blank
Code3

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

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