Not Looping Through
 

Muy code is not going through loops 2) and 3) below, just cant figure it out

Many Thanks

Public Sub coi3()

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
Dim FoundClient As Boolean

'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\TeamCB.xls")
Set fin2 = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamMS.xls")
vArr = Array("Hudson", "HSBC", "C&W")
vArr2 = Array("ACCENT", "AMEX", "SHELL")

FoundClient = False
For Each rCell In Range("D1:D" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
' Check for Team CB's client:
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
FoundClient = True
End If
Next i



1)' If CB's client can skip, otherwise:
If Not FoundClient Then

2)' Check for Team MS's client:
For j = LBound(vArr2) To UBound(vArr2)
If rCell.Value = vArr2(j) Then

Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
..EntireRow.Copy Destination:=sDest
FoundClient = True
End If
Next j

3)' If neither was found, then check your other condition (executiveis CB):
If Not FoundClient Then
If .Offset(0, 3).Value = "CB" Then
..EntireRow.Copy _
Destination:=fin.Worksheets("OTHER").Cells(25, 1).End(xlUp).Offset(1, 0)
End If
End If
End If

End With
Next rCell
End Sub

Not Looping Through
 

Teresa,
have you put a break on this line

For j = LBound(vArr2) To UBound(vArr2)

and tested the values of

LBound(vArr2) and UBound(vArr2)
in the immediate window?

"teresa" wrote in message
...
Muy code is not going through loops 2) and 3) below, just cant figure it
out

Many Thanks

Public Sub coi3()

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
Dim FoundClient As Boolean

'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\TeamCB.xls")
Set fin2 = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamMS.xls")
vArr = Array("Hudson", "HSBC", "C&W")
vArr2 = Array("ACCENT", "AMEX", "SHELL")

FoundClient = False
For Each rCell In Range("D1:D" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
' Check for Team CB's client:
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
FoundClient = True
End If
Next i



1)' If CB's client can skip, otherwise:
If Not FoundClient Then

2)' Check for Team MS's client:
For j = LBound(vArr2) To UBound(vArr2)
If rCell.Value = vArr2(j) Then

Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=sDest
FoundClient = True
End If
Next j

3)' If neither was found, then check your other condition (executiveis
CB):
If Not FoundClient Then
If .Offset(0, 3).Value = "CB" Then
.EntireRow.Copy _
Destination:=fin.Worksheets("OTHER").Cells(25, 1).End(xlUp).Offset(1, 0)
End If
End If
End If

End With
Next rCell
End Sub

Not Looping Through
 

After opening a wb, this wb becomes the ActiveWorkbook and the ActiveSheet by
default becomes Sheet(1) of this wb. Therefore, the second destination
workbook opened (TeamMS.xls) becomes active and the following line, since it
is not qualified, refers to Sheet(1) of this wb:
For Each rCell In Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row)

I suggest after the code that opens the destination workbooks that you
insert the following line to reactivate the original:
ThisWorkbook.Activate

Regards,
Greg

"teresa" wrote:

Muy code is not going through loops 2) and 3) below, just cant figure it out

Many Thanks

Public Sub coi3()

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
Dim FoundClient As Boolean

'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\TeamCB.xls")
Set fin2 = Application.Workbooks.Open( _
"C:\My Documents\Business Plans\TeamMS.xls")
vArr = Array("Hudson", "HSBC", "C&W")
vArr2 = Array("ACCENT", "AMEX", "SHELL")

FoundClient = False
For Each rCell In Range("D1:D" & _
Range("D" & Rows.Count).End(xlUp).Row)
With rCell
' Check for Team CB's client:
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
FoundClient = True
End If
Next i



1)' If CB's client can skip, otherwise:
If Not FoundClient Then

2)' Check for Team MS's client:
For j = LBound(vArr2) To UBound(vArr2)
If rCell.Value = vArr2(j) Then

Set sDest = fin2.Worksheets(vArr2(j)).Cells( _
25, 1).End(xlUp).Offset(1, 0)
.EntireRow.Copy Destination:=sDest
FoundClient = True
End If
Next j

3)' If neither was found, then check your other condition (executiveis CB):
If Not FoundClient Then
If .Offset(0, 3).Value = "CB" Then
.EntireRow.Copy _
Destination:=fin.Worksheets("OTHER").Cells(25, 1).End(xlUp).Offset(1, 0)
End If
End If
End If

End With
Next rCell
End Sub