Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Code not working, copy in Select Case section not copying over.

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
--
Danielle :<)
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Code not working, copy in Select Case section not copying over.

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" wrote:

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
--
Danielle :<)

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Code not working, copy in Select Case section not copying over

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Code not working, copy in Select Case section not copying over

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Code not working, copy in Select Case section not copying over

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Code not working, copy in Select Case section not copying over

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" wrote:

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Code not working, copy in Select Case section not copying over

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.



--
Danielle :<)


"Joel" wrote:

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" wrote:

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Code not working, copy in Select Case section not copying over

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" wrote:

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.



--
Danielle :<)


"Joel" wrote:

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" wrote:

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Code not working, copy in Select Case section not copying over

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?
--
Danielle :<)


"Joel" wrote:

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" wrote:

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.



--
Danielle :<)


"Joel" wrote:

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" wrote:

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Code not working, copy in Select Case section not copying over

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

joel dot warburg at itt dot com

"DanielleVBANewbie" wrote:

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?
--
Danielle :<)


"Joel" wrote:

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" wrote:

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.



--
Danielle :<)


"Joel" wrote:

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" wrote:

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)



  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Code not working, copy in Select Case section not copying over

Hi Joel,

I have sent it to you. Thank you so much.
--
Danielle :<)


"Joel" wrote:

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

joel dot warburg at itt dot com

"DanielleVBANewbie" wrote:

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?
--
Danielle :<)


"Joel" wrote:

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" wrote:

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.



--
Danielle :<)


"Joel" wrote:

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" wrote:

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.
--
Danielle :<)


"Joel" wrote:

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" wrote:

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



--
Danielle :<)


"Joel" wrote:

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" wrote:

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
--
Danielle :<)

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

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


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy contents of a named range to a section on working area Steve Excel Discussion (Misc queries) 1 May 22nd 09 10:36 PM
Simplify Code - Select Case Edgar Thoemmes[_4_] Excel Programming 1 January 19th 05 01:32 AM
Proper case code not working right Juan Excel Programming 3 April 16th 04 11:11 PM
Select Case in VBA not working Ronald Dodge Excel Programming 3 September 11th 03 09:50 PM


All times are GMT +1. The time now is 11:06 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"