Happy Friday Friends,

OK. I think I am in the home stretch on this project. Under the code that
ends with line: "OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value", I
need to figure out how to add code that says basically:

If on sheet "Criteria" (CriteriaSH in the code) cell B5 = Yes, also copy
over the value in columns A, D, P, E, BP, BR, O, for rows (3, 18, 19, 43, 56,
57, 58, 59, 88) from sheet Master Template (Template SH in the Code) to
Internal Project Plan (OutSH) into same columns from the code above this
line.

I was thinking this would be accomplished with an Array but there is already
1 array below. How can I fix this?

Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim OutRow As Long, i As Long
Dim arr As Variant
Dim CopyRow As Boolean
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

'----------------- ADDED ------------------------------------
Dim CriteriaSH As Worksheet
Dim Timeline As Long
Set CriteriaSH = Sheets("Criteria")

Timeline = CriteriaSH.Range("B6")

If Timeline < 60 And _
Timeline < 90 And _
Timeline < 120 Then

MsgBox ("Incorrect TimeLine")
Exit Sub
End If
'----------------- END ------------------------------------


With TemplateSH
For i = 2 To 700
CopyRow = False
For Each ce In CriteriaSH.Range("B15:B80")
If ce = "Yes" Then

'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
Dim C As Variant
Set C = TemplateSH.Rows("1:1").Find( _
what:=ce.Offset(0, -1).Value, _
LookIn:=xlValues, _
lookat:=xlWhole)
If C Is Nothing Then
MsgBox ("Could not find : " & _
ce.Offset(0, -1).Value)
Exit Sub
Else
If .Cells(i, C.Column).Value = "x" Then
CopyRow = True
Exit For
End If
End If
End If
Next ce

If CopyRow = True Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, "A").Value = .Cells(i, "A").Value
OutSH.Cells(OutRow, "B").Value = .Cells(i, "D").Value
OutSH.Cells(OutRow, "C").Value = .Cells(i, "P").Value
OutSH.Cells(OutRow, "D").Value = .Cells(i, "E").Value
OutSH.Cells(OutRow, "I").Value = .Cells(i, "BP").Value
OutSH.Cells(OutRow, "J").Value = .Cells(i, "BR").Value
OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value

'--------------------------- New Code -----------------------
Select Case Timeline

Case 60
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "H").Value
Case 90
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "K").Value
Case 120
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "N").Value
End Select
End If
'---------------------------End ----------------------------- End If
Next i
End With


'----------------------------------------------------------------
Application.StatusBar = "Transferring Headings"
arr = Array(2, 16, 85, 97, 98, 111, 127, 145, 160, 185, 193, 196, 211,
241, 308, 329, 340, 433, 447, 451, 476, 522, 549, 568, 597)


'moved outrow to this location and added counter inside loop
OutRow = OutSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
With TemplateSH
For i = LBound(arr) To UBound(arr)

.Cells(arr(i), "A").Copy _
Destination:=OutSH.Cells(OutRow, "A")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "A").Value = .Cells(arr(i), "A").Value

.Cells(arr(i), "D").Copy _
Destination:=OutSH.Cells(OutRow, "B")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "B").Value = .Cells(arr(i), "D").Value

.Cells(arr(i), "J").Copy _
Destination:=OutSH.Cells(OutRow, "C")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "C").Value = .Cells(arr(i), "J").Value

.Cells(arr(i), "E").Copy _
Destination:=OutSH.Cells(OutRow, "D")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "D").Value = .Cells(arr(i), "E").Value


.Cells(arr(i), "BP").Copy _
Destination:=OutSH.Cells(OutRow, "I")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "I").Value = .Cells(arr(i), "BQ").Value

'added row below
OutRow = OutRow + 1
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
'-------------------------- CHANGED ------------------------------
'change this statement
.Range("A6:J" & (OutRow - 1)).Sort _
key1:=.Range("A6"), _
order1:=xlAscending, _
header:=xlYes
'---------------------------- ENd ---------------------------------
End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
End Sub

Thanks



--
Danielle :<)