Copy column to WKst1 from match of wksht 2 and 3
 

I have a worksbook that has a "Criteria" sheet where the users enter specific
information; A master template that houses all data, and an Internal Project
Plan that is created based on the multiple criteria.

I am new to VBA so I am not sure how to build this.

I need code that says for all rows that match (there is a row ID in column A
and each row has a numeric number), if Cell B50 =60 Copy Column H from Master
Template to column E of the Internal Project plan. The second layer would be
if cell B50=90 copy column J to column E, and the final would be if cell
B50=120 copy column N.

I appreciate any assistance you can provide.
Thanks
--
Danielle :<)

Copy column to WKst1 from match of wksht 2 and 3
 

Not usre if this is right. You can't tell from your posting where the data
is suppose to go. I put the data at the end of the worksheet. You may want
to do some lookup, but it is not clear from your description.


Sub movedata()

With Sheets("Internal Project plan")
'get Last row. data will be placed
'at end of data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End With

With Sheets("master template")
RowCount = 1
Do While .Range("A" & RowCount) < ""
Data = ""
Select Case .Range("B" & RowCount)

Case 60
Data = .Range("H" & RowCount)
Case 90
Data = .Range("J" & RowCount)
Case 120
Data = .Range("N" & RowCount)
End Select

With Sheets("Internal Project plan")
If Data < "" Then
.Range("E" & LastRow) = Data
LastRow = LastRow + 1
End If
End With
RowCount = RowCount + 1
Loop
End With
End Sub


"DanielleVBANewbie" wrote:

I have a worksbook that has a "Criteria" sheet where the users enter specific
information; A master template that houses all data, and an Internal Project
Plan that is created based on the multiple criteria.

I am new to VBA so I am not sure how to build this.

I need code that says for all rows that match (there is a row ID in column A
and each row has a numeric number), if Cell B50 =60 Copy Column H from Master
Template to column E of the Internal Project plan. The second layer would be
if cell B50=90 copy column J to column E, and the final would be if cell
B50=120 copy column N.

I appreciate any assistance you can provide.
Thanks
--
Danielle :<)

Copy column to WKst1 from match of wksht 2 and 3
 

After reading this I thought I could make it a little more clear.

There are three worksheets
"Criteria" (user entered data), Sheet 1
"Master Template" which houses all the data, Sheet 8
"Internal Project Plan" (this is the sheet where the rows that meet the
criteria page are copied over. The code to copy the rows over are in the
original post. Sheet 3

In the Master Template there are three columns
120 days due date (Column N)
90 days due date (Column K)
60 days due date (Column H)

In the criteria sheet there is a drop down where the user enters what the
timeline is for the client (60/90/120) (cell b5)

What I need is to somehow change the original code to pull the correct
column (under number 2) based on whether the end user entered 60/90/120.

If the user choose 60 days, column H from the master template should copy
with the row.

If the user choose 90 days, column K from the master template should copy
with the row.

If the user choose 120 days, column N from the master template should copy
with the row.

I am sure that the current code can just be changed to include this,
however, I am a real newbie at this and I have no idea how. Thank you so much
for anything you can do to help or even point me in the right direction.

Here is the original code:
Private Sub CommandButton1_Click()
Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim DataCol As Integer, OutRow As Long, i As Long
Dim arr As Variant
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

For Each ce In Range("B15:B80")
If ce = "Yes" Then
DataCol = WorksheetFunction.Match(ce.Offset(0, -1).Value,
TemplateSH.Rows("1:1"), 0)
With TemplateSH
For i = 2 To 700
If .Cells(i, DataCol).Value = "x" Then
'check to see if it already exists and only proceed if it does not
If WorksheetFunction.CountIf(OutSH.Range("A:A"),
TemplateSH.Cells(i, 1).Value) = 0 Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, 1).Value = .Cells(i, 1).Value
OutSH.Cells(OutRow, 2).Value = .Cells(i, 4).Value
OutSH.Cells(OutRow, 3).Value = .Cells(i, 16).Value
OutSH.Cells(OutRow, 4).Value = .Cells(i, 5).Value
OutSH.Cells(OutRow, 9).Value = .Cells(i, 69).Value
End If
End If
Next i
End With
End If
Next ce
Application.StatusBar = "Transferring Headings"
arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)
With TemplateSH
For i = LBound(arr) To UBound(arr)
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Cells(arr(i), 1).Copy Destination:=OutSH.Cells(OutRow, 1)
OutSH.Cells(OutRow, 1).Value = .Cells(arr(i), 1).Value
.Cells(arr(i), 4).Copy Destination:=OutSH.Cells(OutRow, 2)
OutSH.Cells(OutRow, 2).Value = .Cells(arr(i), 4).Value
.Cells(arr(i), 10).Copy Destination:=OutSH.Cells(OutRow, 3)
OutSH.Cells(OutRow, 3).Value = .Cells(arr(i), 10).Value
.Cells(arr(i), 5).Copy Destination:=OutSH.Cells(OutRow, 4)
OutSH.Cells(OutRow, 4).Value = .Cells(arr(i), 5).Value
.Cells(arr(i), 69).Copy Destination:=OutSH.Cells(OutRow, 9)
OutSH.Cells(OutRow, 9).Value = .Cells(arr(i), 69).Value
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
.Range("A6:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort
key1:=.Range("A6"), order1:=xlAscending, header:=xlYes

End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
--
Danielle :<)


"Joel" wrote:

Not usre if this is right. You can't tell from your posting where the data
is suppose to go. I put the data at the end of the worksheet. You may want
to do some lookup, but it is not clear from your description.


Sub movedata()

With Sheets("Internal Project plan")
'get Last row. data will be placed
'at end of data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End With

With Sheets("master template")
RowCount = 1
Do While .Range("A" & RowCount) < ""
Data = ""
Select Case .Range("B" & RowCount)

Case 60
Data = .Range("H" & RowCount)
Case 90
Data = .Range("J" & RowCount)
Case 120
Data = .Range("N" & RowCount)
End Select

With Sheets("Internal Project plan")
If Data < "" Then
.Range("E" & LastRow) = Data
LastRow = LastRow + 1
End If
End With
RowCount = RowCount + 1
Loop
End With
End Sub


"DanielleVBANewbie" wrote:

I have a worksbook that has a "Criteria" sheet where the users enter specific
information; A master template that houses all data, and an Internal Project
Plan that is created based on the multiple criteria.

I am new to VBA so I am not sure how to build this.

I need code that says for all rows that match (there is a row ID in column A
and each row has a numeric number), if Cell B50 =60 Copy Column H from Master
Template to column E of the Internal Project plan. The second layer would be
if cell B50=90 copy column J to column E, and the final would be if cell
B50=120 copy column N.

I appreciate any assistance you can provide.
Thanks
--
Danielle :<)

Copy column to WKst1 from match of wksht 2 and 3
 

See comments in code below. Made some minor improvements besides the comments.

You could also change

from
.Cells(i, "A").Value
to
.Range("A" & i).value

I like to use Range because I'm only thinking the same way (colun then row).
I find it is a little confusing to keep on switch back from: "column then
row" - to: "row then column". This is a preference and is not a problem. I
tried to always use RANGE and not CELLS. sometimes you have to use cells()
method.



Private Sub CommandButton1_Click()
Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim DataCol As Integer, OutRow As Long, i As Long
Dim arr As Variant
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

'----------------- ADDED ------------------------------------
Set CriteriaSH = Sheets("Master Template")

TimeLine = CriteriaSH.Range("B5")

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

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

For Each ce In Range("B15:B80")
If ce = "Yes" Then

'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
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
DataCol = c.Column
End If

'------------------ END -------------

With TemplateSH
For i = 2 To 700
If .Cells(i, DataCol).Value = "x" Then

'check to see if it already exists and
'only proceed if it does not
If WorksheetFunction.CountIf(OutSH.Range("A:A"), _
TemplateSH.Cells(i, 1).Value) = 0 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, "BQ").Value
End If
End If
Next i
End With
End If
Next ce
Application.StatusBar = "Transferring Headings"
arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)


'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

'--------------------------- New Code -----------------------
Select Case TimeLine

Case 60
.Cells(arr(i), "H").Copy _
Destination:=OutSH.Cells(OutRow, "E")
Case 90
.Cells(arr(i), "K").Copy _
Destination:=OutSH.Cells(OutRow, "E")
Case 120
.Cells(arr(i), "N").Copy _
Destination:=OutSH.Cells(OutRow, "E")
End Select

'---------------------------End -----------------------------
.Cells(arr(i), "BQ").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

"DanielleVBANewbie" wrote:

After reading this I thought I could make it a little more clear.

There are three worksheets
"Criteria" (user entered data), Sheet 1
"Master Template" which houses all the data, Sheet 8
"Internal Project Plan" (this is the sheet where the rows that meet the
criteria page are copied over. The code to copy the rows over are in the
original post. Sheet 3

In the Master Template there are three columns
120 days due date (Column N)
90 days due date (Column K)
60 days due date (Column H)

In the criteria sheet there is a drop down where the user enters what the
timeline is for the client (60/90/120) (cell b5)

What I need is to somehow change the original code to pull the correct
column (under number 2) based on whether the end user entered 60/90/120.

If the user choose 60 days, column H from the master template should copy
with the row.

If the user choose 90 days, column K from the master template should copy
with the row.

If the user choose 120 days, column N from the master template should copy
with the row.

I am sure that the current code can just be changed to include this,
however, I am a real newbie at this and I have no idea how. Thank you so much
for anything you can do to help or even point me in the right direction.

Here is the original code:
Private Sub CommandButton1_Click()
Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim DataCol As Integer, OutRow As Long, i As Long
Dim arr As Variant
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

For Each ce In Range("B15:B80")
If ce = "Yes" Then
DataCol = WorksheetFunction.Match(ce.Offset(0, -1).Value,
TemplateSH.Rows("1:1"), 0)
With TemplateSH
For i = 2 To 700
If .Cells(i, DataCol).Value = "x" Then
'check to see if it already exists and only proceed if it does not
If WorksheetFunction.CountIf(OutSH.Range("A:A"),
TemplateSH.Cells(i, 1).Value) = 0 Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, 1).Value = .Cells(i, 1).Value
OutSH.Cells(OutRow, 2).Value = .Cells(i, 4).Value
OutSH.Cells(OutRow, 3).Value = .Cells(i, 16).Value
OutSH.Cells(OutRow, 4).Value = .Cells(i, 5).Value
OutSH.Cells(OutRow, 9).Value = .Cells(i, 69).Value
End If
End If
Next i
End With
End If
Next ce
Application.StatusBar = "Transferring Headings"
arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)
With TemplateSH
For i = LBound(arr) To UBound(arr)
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Cells(arr(i), 1).Copy Destination:=OutSH.Cells(OutRow, 1)
OutSH.Cells(OutRow, 1).Value = .Cells(arr(i), 1).Value
.Cells(arr(i), 4).Copy Destination:=OutSH.Cells(OutRow, 2)
OutSH.Cells(OutRow, 2).Value = .Cells(arr(i), 4).Value
.Cells(arr(i), 10).Copy Destination:=OutSH.Cells(OutRow, 3)
OutSH.Cells(OutRow, 3).Value = .Cells(arr(i), 10).Value
.Cells(arr(i), 5).Copy Destination:=OutSH.Cells(OutRow, 4)
OutSH.Cells(OutRow, 4).Value = .Cells(arr(i), 5).Value
.Cells(arr(i), 69).Copy Destination:=OutSH.Cells(OutRow, 9)
OutSH.Cells(OutRow, 9).Value = .Cells(arr(i), 69).Value
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
.Range("A6:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort
key1:=.Range("A6"), order1:=xlAscending, header:=xlYes

End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
--
Danielle :<)


"Joel" wrote:

Not usre if this is right. You can't tell from your posting where the data
is suppose to go. I put the data at the end of the worksheet. You may want
to do some lookup, but it is not clear from your description.


Sub movedata()

With Sheets("Internal Project plan")
'get Last row. data will be placed
'at end of data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End With

With Sheets("master template")
RowCount = 1
Do While .Range("A" & RowCount) < ""
Data = ""
Select Case .Range("B" & RowCount)

Case 60
Data = .Range("H" & RowCount)
Case 90
Data = .Range("J" & RowCount)
Case 120
Data = .Range("N" & RowCount)
End Select

With Sheets("Internal Project plan")
If Data < "" Then
.Range("E" & LastRow) = Data
LastRow = LastRow + 1
End If
End With
RowCount = RowCount + 1
Loop
End With
End Sub


"DanielleVBANewbie" wrote:

I have a worksbook that has a "Criteria" sheet where the users enter specific
information; A master template that houses all data, and an Internal Project
Plan that is created based on the multiple criteria.

I am new to VBA so I am not sure how to build this.

I need code that says for all rows that match (there is a row ID in column A
and each row has a numeric number), if Cell B50 =60 Copy Column H from Master
Template to column E of the Internal Project plan. The second layer would be
if cell B50=90 copy column J to column E, and the final would be if cell
B50=120 copy column N.

I appreciate any assistance you can provide.
Thanks
--
Danielle :<)

Copy column to WKst1 from match of wksht 2 and 3
 

Hi Joel,

Thank you, I had a feeling this could be somewhat easier.

I am getting compile errors at:
Set CriteriaSH = Sheets("Master Template")
It says variable not defined so I put in "Dim CriteriaSH as Worksheet"

Timeline = CriteriaSH.Range("B5")
It says variable not defined as well, so I put in Dim Timeline as
Variant "Incorrect Timeline" so I am assuming I have not defined them
correctly?

Thanks again for all your help, I really appreciate it.

Set c = TemplateSH.Rows("1:1").Find( _
It says variable not defined, so I put Dim c as variant

After I put this in it just keeps coming up with the message box







--
Danielle :<)


"Joel" wrote:

See comments in code below. Made some minor improvements besides the comments.

You could also change

from
.Cells(i, "A").Value
to
.Range("A" & i).value

I like to use Range because I'm only thinking the same way (colun then row).
I find it is a little confusing to keep on switch back from: "column then
row" - to: "row then column". This is a preference and is not a problem. I
tried to always use RANGE and not CELLS. sometimes you have to use cells()
method.



Private Sub CommandButton1_Click()
Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim DataCol As Integer, OutRow As Long, i As Long
Dim arr As Variant
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

'----------------- ADDED ------------------------------------
Set CriteriaSH = Sheets("Master Template")

TimeLine = CriteriaSH.Range("B5")

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

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

For Each ce In Range("B15:B80")
If ce = "Yes" Then

'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
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
DataCol = c.Column
End If

'------------------ END -------------

With TemplateSH
For i = 2 To 700
If .Cells(i, DataCol).Value = "x" Then

'check to see if it already exists and
'only proceed if it does not
If WorksheetFunction.CountIf(OutSH.Range("A:A"), _
TemplateSH.Cells(i, 1).Value) = 0 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, "BQ").Value
End If
End If
Next i
End With
End If
Next ce
Application.StatusBar = "Transferring Headings"
arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)


'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

'--------------------------- New Code -----------------------
Select Case TimeLine

Case 60
.Cells(arr(i), "H").Copy _
Destination:=OutSH.Cells(OutRow, "E")
Case 90
.Cells(arr(i), "K").Copy _
Destination:=OutSH.Cells(OutRow, "E")
Case 120
.Cells(arr(i), "N").Copy _
Destination:=OutSH.Cells(OutRow, "E")
End Select

'---------------------------End -----------------------------
.Cells(arr(i), "BQ").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

"DanielleVBANewbie" wrote:

After reading this I thought I could make it a little more clear.

There are three worksheets
"Criteria" (user entered data), Sheet 1
"Master Template" which houses all the data, Sheet 8
"Internal Project Plan" (this is the sheet where the rows that meet the
criteria page are copied over. The code to copy the rows over are in the
original post. Sheet 3

In the Master Template there are three columns
120 days due date (Column N)
90 days due date (Column K)
60 days due date (Column H)

In the criteria sheet there is a drop down where the user enters what the
timeline is for the client (60/90/120) (cell b5)

What I need is to somehow change the original code to pull the correct
column (under number 2) based on whether the end user entered 60/90/120.

If the user choose 60 days, column H from the master template should copy
with the row.

If the user choose 90 days, column K from the master template should copy
with the row.

If the user choose 120 days, column N from the master template should copy
with the row.

I am sure that the current code can just be changed to include this,
however, I am a real newbie at this and I have no idea how. Thank you so much
for anything you can do to help or even point me in the right direction.

Here is the original code:
Private Sub CommandButton1_Click()
Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim DataCol As Integer, OutRow As Long, i As Long
Dim arr As Variant
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

For Each ce In Range("B15:B80")
If ce = "Yes" Then
DataCol = WorksheetFunction.Match(ce.Offset(0, -1).Value,
TemplateSH.Rows("1:1"), 0)
With TemplateSH
For i = 2 To 700
If .Cells(i, DataCol).Value = "x" Then
'check to see if it already exists and only proceed if it does not
If WorksheetFunction.CountIf(OutSH.Range("A:A"),
TemplateSH.Cells(i, 1).Value) = 0 Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, 1).Value = .Cells(i, 1).Value
OutSH.Cells(OutRow, 2).Value = .Cells(i, 4).Value
OutSH.Cells(OutRow, 3).Value = .Cells(i, 16).Value
OutSH.Cells(OutRow, 4).Value = .Cells(i, 5).Value
OutSH.Cells(OutRow, 9).Value = .Cells(i, 69).Value
End If
End If
Next i
End With
End If
Next ce
Application.StatusBar = "Transferring Headings"
arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)
With TemplateSH
For i = LBound(arr) To UBound(arr)
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Cells(arr(i), 1).Copy Destination:=OutSH.Cells(OutRow, 1)
OutSH.Cells(OutRow, 1).Value = .Cells(arr(i), 1).Value
.Cells(arr(i), 4).Copy Destination:=OutSH.Cells(OutRow, 2)
OutSH.Cells(OutRow, 2).Value = .Cells(arr(i), 4).Value
.Cells(arr(i), 10).Copy Destination:=OutSH.Cells(OutRow, 3)
OutSH.Cells(OutRow, 3).Value = .Cells(arr(i), 10).Value
.Cells(arr(i), 5).Copy Destination:=OutSH.Cells(OutRow, 4)
OutSH.Cells(OutRow, 4).Value = .Cells(arr(i), 5).Value
.Cells(arr(i), 69).Copy Destination:=OutSH.Cells(OutRow, 9)
OutSH.Cells(OutRow, 9).Value = .Cells(arr(i), 69).Value
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
.Range("A6:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort
key1:=.Range("A6"), order1:=xlAscending, header:=xlYes

End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
--
Danielle :<)


"Joel" wrote:

Not usre if this is right. You can't tell from your posting where the data
is suppose to go. I put the data at the end of the worksheet. You may want
to do some lookup, but it is not clear from your description.


Sub movedata()

With Sheets("Internal Project plan")
'get Last row. data will be placed
'at end of data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End With

With Sheets("master template")
RowCount = 1
Do While .Range("A" & RowCount) < ""
Data = ""
Select Case .Range("B" & RowCount)

Case 60
Data = .Range("H" & RowCount)
Case 90
Data = .Range("J" & RowCount)
Case 120
Data = .Range("N" & RowCount)
End Select

With Sheets("Internal Project plan")
If Data < "" Then
.Range("E" & LastRow) = Data
LastRow = LastRow + 1
End If
End With
RowCount = RowCount + 1
Loop
End With
End Sub


"DanielleVBANewbie" wrote:

I have a worksbook that has a "Criteria" sheet where the users enter specific