PC Review


Reply
Thread Tools Rate Thread

Copy column to WKst1 from match of wksht 2 and 3

 
 
DanielleVBANewbie
Guest
Posts: n/a
 
      15th Jul 2008
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 :<)
 
Reply With Quote
 
 
 
 
Joel
Guest
Posts: n/a
 
      15th Jul 2008
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 :<)

 
Reply With Quote
 
DanielleVBANewbie
Guest
Posts: n/a
 
      16th Jul 2008
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 :<)

 
Reply With Quote
 
Joel
Guest
Posts: n/a
 
      16th Jul 2008
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 :<)

 
Reply With Quote
 
DanielleVBANewbie
Guest
Posts: n/a
 
      16th Jul 2008
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

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Match Column and copy to cell Column D Jeffrey Yau Microsoft Excel Worksheet Functions 1 26th Oct 2009 12:53 AM
Match value from column A to column A on 2nd sheet and then copy R DanS Microsoft Excel Programming 2 16th Feb 2009 09:03 PM
1st 2 rows of wksht show up @ top of each page of the wksht Remote Paralegal Microsoft Excel Misc 2 6th Oct 2008 07:59 PM
I've protected a wksht and now I can't tab from column to column =?Utf-8?B?Y2Fyb2wgYg==?= Microsoft Excel Worksheet Functions 1 19th Oct 2005 10:15 PM
Match Header...Copy Column mjack003 Microsoft Excel Misc 6 23rd Sep 2005 01:33 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 07:59 AM.