Object Required

[teresa]

This macro is attempting to perform the following:
If a value in D Col is in the array then the line is copied to the
associated worksheet.
However if the value isnt in the array but the G Col value is "CC", then
line should
be copied to "WP" worksheet,
If neither condition holds but H Col value is XY then copies line to "Other"
Worksheet

Its with the two else statements that Im having problems, my last error
message was 'Object Required'

Many Thanks



Public Sub coiD()
Dim fin As Workbook
Dim vArr As Variant
Dim rCell As Range
Dim rDest As Range
Dim i As Long

Set fin = Application.Workbooks.Open( _
"C:\My Documents\Business Plans.xls")
vArr = Array("Hudson", "HS", "C&W")
For Each rCell In Range("D1" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vArr) To UBound(vArr)
If .Value = vArr(i) Then
Set rDest = fin.Worksheets(vArr(i)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
'If rDest.Row < 18 Then _
' Set rDest = rDest.Offset(18 - rDest.Row, 0)
.EntireRow.Copy Destination:=rDest
Else: If .Offset(0, 3).Value = "CC" Then
EntireRow.Copy _
Destination:=fin.Worksheets("WP").Cells(25,
1).End(xlUp).Offset(1, 0)
Else: If .Offset(0, 4).Value = "XY" Then EntireRow.Copy _
Destination:=fin.Worksheets("Other").Cells(25,
1).End(xlUp).Offset(1, 0)

Exit For
End If
Next i
End With
Next rCell
End Sub

 

[Bob Phillips]

Teresa,

I hesitate to say that this worked for me as I don't have your data, but it
didn't reproduce the error.

What does the data look like?

Public Sub coiD()
Dim fin As Workbook
Dim vArr As Variant
Dim rCell As Range
Dim rDest As Range
Dim i As Long

Set fin = Application.Workbooks.Open( _
"C:\My Documents\Business Plans.xls")
vArr = Array("Hudson", "HS", "C&W")
For Each rCell In Range("D1" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vArr) To UBound(vArr)
If .Value = vArr(i) Then
Set rDest = fin.Worksheets(vArr(i)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=rDest
ElseIf .Offset(0, 3).Value = "CC" Then
.EntireRow.Copy _
Destination:=fin.Worksheets("WP").Cells(25,
1).End(xlUp).Offset(1, 0)
ElseIf .Offset(0, 4).Value = "XY" Then
.EntireRow.Copy _
Destination:=fin.Worksheets("Other").Cells(25,
1).End(xlUp).Offset(1, 0)
Exit For
End If
Next i
End With
Next rCell
End Sub

 

[teresa]

Hi Bob, Ive just run through the code and at the line below (when Criteria is
met) I get Run-time error '424' Object Required.

ElseIf .Offset(0, 3).Value = "CC" Then

.EntireRow.Copy _
Destination:=fin.Worksheets("WP").Cells(25,
1).End(xlUp).Offset(1, 0)

What does the data look like?

Normal spreadsheet, cols A:M
thre are two blank columns between D and G

Any more questions, let me know- thanks

ElseIf .Offset(0, 3).Value = "CC" Then

.EntireRow.Copy _

I get

 

[Bob Phillips]

what is in the columns though? It looks to me that you are trying to address
off-sheet, but I can't replicate yet.

 

[teresa]

A B C D E F
G
Job Number Project Title Value Client Name Executive
1 asd 10000 ACCENT CC

There are 50 rows like above format
not all the G values are Populated,

Dont know if this is relevant but all the cells are formatted "General"

 

[Bob Phillips]

Teresa,

Can you post a spreadsheet somewhere, somewhere like
http://flypicture.com/index.cfm?display=upload

 

[teresa]

<a href="http://flypicture.com/p.cfm?id=56181">Download Link<a/>

 

[Bob Phillips]

Teresa,

Downloaded it and ran it and I didn't get the error. No data was copied to
the MS workbook, but there was data on all 3 sheets of the CB sheet.

Sorry!

 

[teresa]

Thanks Bob- good to realize its not my coding, ill try it again elsewhere,
A separate question...
What am I missing below as i can get entries onto Team CB but not Team MS,
even though I know I have entries which should go Team MS,
it doesnt seem to be completely processing, think Im missing a next or
something....


Public Sub coi()
Dim fin As Workbook
Dim fin2 As Workbook
Dim vArr As Variant
Dim vArr2 As Variant
Dim rCell As Range
Dim rDest As Range
Dim sDest As Range
Dim i As Long
Dim j As Long

'1)Opens Team CB and Team MS Workbooks,define arrays in line with
Client Lists
Set fin = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamC.xls")
Set fin2 = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamM.xls")
vArr = Array("Hudson", "HSB", "C&W")
vArr2 = Array("ACCENT", "AME", "SHELL")

'2) Loops through Client Names in D Column, if equals Designated
Client copies
'line to appropriate w/sheet
For Each rCell In Range("D1" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vArr) To UBound(vArr)
For j = LBound(vArr2) To UBound(vArr2)
If .Value = vArr(i) Then
Set rDest = fin.Worksheets(vArr(i)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
'If rDest.Row < 18 Then _
' Set rDest = rDest.Offset(18 - rDest.Row, 0)
.EntireRow.Copy Destination:=rDest
'3) If Client is not designated Client but Executive is CB copies
to "Other"
'Else: If .Offset(0, 3).Value = "CB" Then
EntireRow.Copy _
'Destination:=fin.Worksheets("OTHER").Cells(25,
1).End(xlUp).Offset(1, 0)
If .Value = vArr2(j) Then
Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=sDest
Exit For

End If
End If
Next j
Next i
End With
Next rCell
End Sub

 

[Bob Phillips]

I think you need to change this

If .Value = vArr2(j) Then
Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=sDest
Exit For
End If
End If

to this

ElseIf .Value = vArr2(j) Then
Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=sDest
Exit For
End If