Looping trouble

[JC]

I am trying to create a macro that will check a column in
one spreadsheet against a column in another. Everything
works fine but when it finds a match it copies the data I
want twice. I am using two FOR EACH statements and I
think that's where my problem is located. Here is some
of my code:
For Each x In CheckCell
For Each y In CompareRange
If x = y Then GoTo Paste Else GoTo Repeat
Paste:

xxx There are some loops here that copy cells from one
spreadsheet to another xxx

Repeat:
Next y
Next x
CheckCell is col C on spreadsheet 1 and CompareRange is
col B on spreadsheet 2. So I'm trying to find cells that
match in both ranges and when I find that match copy
certain cells in that row to spreadsheet 2. Again, it
does this, but it copies everything twice.

CloseDate WO# Description Notes Charge
1/29/2003 11094 Had initial Meeting 2
1/29/2003 11094 Had initial Meeting 2
2/13/2003 11094 Worked on the IP Scheme 1
2/13/2003 11094 Worked on the IP scheme 1

I'd like to fix the duplicates problem without having to
write another macro that deletes every other line.
Thanks for any help you can provide. This forum is
great!!

JC

 

[Jim Rech]

I can't see what's going wrong based on this. It may be in the details
you're not providing. But it seems to me you have some superfluous GoTos.
You don't need them and in general should avoid them:

For Each x In CheckCell
For Each y In CompareRange
If x.Value = y.Value Then
'Do Paste Routine
End If
Next y
Next x

 

[steve]

JC,

Here's some code that I just wrote to compare and copy... In my case
I am using 3 different workbooks, but it doesn't really matter.
You can use 2 countif's for the double comparison...

===========================================
Dim wbk1 as Workbook, wbk2 as Workbook, mbk as Workbook, _
x as Integer, prow as Long

For Each cel In wbk1.Sheets(x).Range("C11:C36")
If Len(cel) > 0 Then
If WorksheetFunction.CountIf(wbk2.Sheets(x). _
Range("C11:C36"), cel) > 0 Then
prow = mbk.Sheets(3).Cells(Rows.Count, "B").End(xlUp) _
.Offset(1, 0).Row
wbk1.Sheets(x).Range(cel.Offset(0, -1).Address, cel.Address) _
.Copy _
Destination:=mbk.Sheets(x + 2).Range(cel.Offset(0, -1) _
.Address)
End If
End If
Next