Prev: Printing Problem
Next: Excel loses mind clearing VBA global variables
From: DanielleVBANewbie on 21 Jul 2008 16:59
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 :<)
From: Joel on 21 Jul 2008 22:38
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 :<)
 | 
Pages: 1
Prev: Printing Problem
Next: Excel loses mind clearing VBA global variables