Code not working, copy in Select Case section not copying over.

[DanielleVBANewbie]

Hi friends,

The code below is to copy information that matches in one sheet to another
sheet. I am having problems with one area where I need it to look at
criteria of days. Everything is working fine except this:
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

If any of you could look at this, I am sure I have just missed fixing
something for it not to pull over, because I don't get a compile error or
anything like that.

Thanks






Entire 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")

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

Timeline = CriteriaSH.Range("B5")

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

MsgBox ("Incorrect TimeLine")
Exit Sub
End If

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

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
DataCol = C.Column
End If


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, 88, 117, 134, 149, 172, 179, 182, 197, 227,
294, 315, 326, 418, 432, 436, 461, 507, 534, 553, 582)


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")


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

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

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

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

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

OutRow = OutRow + 1
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
.Range("A6:J" & (OutRow - 1)).Sort _
key1:=.Range("A6"), _
order1:=xlAscending, _
header:=xlYes

End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select
Call Colors
Call Module6.SaveAs
End Sub

 

[Joel]

Use this for debugging. The code is good, the data isn't


msgbox("TimeLine = " & TimeLine & ",i = " & i & ",arr(i) = " & arr(i))
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

 

[DanielleVBANewbie]

Hi Joel,

Thank you for the debugging information, it appears it is picking up the
arrays from the above code (pasted below) because it says Timeline=60, i=0,
arr(i)=2 and then it kept going through all the numbers below.

I am needing it to pull the timelines for all rows, not just the title rows
that are in the array. Is there somewhere I can post the sheet for you to
view?


"arr = Array(2, 15, 77, 87, 88, 117, 134, 149, 172, 179, 182, 197, 227,
294, 315, 326, 418, 432, 436, 461, 507, 534, 553, 582)


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") "

 

[Joel]

The code works correctly. the problem is you have old data on sheet
"Internal Project Plan". If you clear all the data on this sheet it will
work properly. The code cannot recover the old data on the lines before the
last line.

 

[DanielleVBANewbie]

Hi Joel, the Internal Project Plan is empty until this code runs with the
button click. I put dates in the title rows and they do pull over, but not
for the rest of the sheet.

 

[Joel]

I'm confused. Your first posting said everything is working except the
Select Case. Now the select case is working what ISN"T working. the code
appears to do everything it is programmed to do

1) Moves over rows 2 to 700
2) Moves over header row.
3) sort Data

Now what isn't working??????????

 

[DanielleVBANewbie]

Hi Joel.

I really do think we are on the right track it is just the rows it is pulling.

So when I debug the code:
Everything works as expected except the select case code. In the Master
Template the title rows do not have dates, so when I ran your code you sent
this morning it came up with just these rows. So to test, I put dates in
these rows and with the code as is, these are the only dates pulling over.

The title rows are stated in the code as:
arr = Array(2, 15, 77, 87, 88, 117, 134, 149, 172, 179, 182, 197, 227, 294,
315, 326, 418, 432, 436, 461, 507, 534, 553, 582)

So when I look at the select case it says .Cells(arr(i), "N").Copy _, so
since we have the "arr" is that why it is only pulling those rows? If so,
what do we replace it with to make it pull any row that exists?

I really do appreciate all of your help.

 

[Joel]

I think I found the problem. It is with the code below

from
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

to

If WorksheetFunction.CountIf(OutSH.Range("A:A"), _
TemplateSH.Cells(i, DataCol).Value) = 0 Then

OutRow = OutSH.Cells(Rows.Count, DataCol).End(xlUp).Row


The column 1 is A and if you don't have an entry in a row for column A is
wasn't working.

 

[DanielleVBANewbie]

Hi Joel,

That actually made it stop pulling over all rows but the title rows.

Is there somewhere I can post or email you the spreadsheet to view?

 

[Joel]

I won't bed able to look at it until late tonight

joel dot warburg at itt dot com

 

[DanielleVBANewbie]

Hi Joel,

I have sent it to you. Thank you so much.