Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 :<) |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
copy contents of a named range to a section on working area | Excel Discussion (Misc queries) | |||
Simplify Code - Select Case | Excel Programming | |||
Proper case code not working right | Excel Programming | |||
Select Case in VBA not working | Excel Programming |