Bernie,
Thank you. I thought that was the solution but when I
repeated the search the macro repeatedly added existing
records. I do not understand why. The solution works
perfectly for unique customers but not for existing.
Rather than 'new' it is perhaps better to describe them
as current, though Cols A and B will change they will
always contain items recorded in the archive.
Rather than use Cust1 notation etc it is easier to read
if I use more distinctive names.
Col A Col B Col E Col F
Jones Leeds Jones Leeds
Jones Norwich Manning Colne
Lane Leeds Manning Bristol
Smith London Smith London
Smith York Smith York
In this example the missing record Jones, Norwich is
added correctly to the archive but also Lane, Leeds and
Smith, York. The last two records are repeated each time
the macro is run.

Still working on it.

Geoff


-----Original Message-----
Geoff,

Below is a working version of your macro. You didn't
write your data
to your
record set when there was a match on the second or later
instance of
the
primary key value.

And you asked

Do I have to start at the beginning if the list is
sorted??

No, but it doesn't hurt, and don't count on it being
sorted. Anyway,
..Findnext will wrap around the range, so it is
immaterial.

HTH,
Bernie


Sub aaaa()
Dim rng As Range, rng1 As Range, rng3 As Range
Dim cust As Range, i As Integer, firstFind As String

Set rng = Range("A1")
Set cust = Range("E1")

With Sheets(1)
Set rng1 = .Range(.Range("A1"), .Range("A1:A" & .Range _
("A65536").End(xlUp).Row))
Set rng3 = .Range(.Range("E1"), .Range("E1:E" & .Range _
("E65536").End(xlUp).Row))

i = 0
For Each rng In rng1
Set cust = rng3.Find(what:=rng, _
After:=rng3(1), _
SearchDirection:=xlNext)
firstFind = ""
If Not cust Is Nothing Then
Do Until rng.Offset(0, 1) = cust.Offset(0,
1) Or
cust.Address = firstFind
If firstFind = "" Then firstFind =
cust.Address
Set cust = rng3.FindNext(After:=cust)
.Range("E65536").End(xlUp)(2).Value =
rng.Value
.Range("f65536").End(xlUp)(2).Value =
rng.Offset(0,
1).Value
i = i + 1
Loop
Else
.Range("E65536").End(xlUp)(2).Value =
rng.Value
.Range("f65536").End(xlUp)(2).Value =
rng.Offset(0,
1).Value
i = i + 1
End If
Next rng
End With
End Sub


"Geoff" wrote in message
...
Hi,
I have 4 columns, A and B are new customers and
locations, E and F are archived customers and
locations.
I need to add new customer details to the archived list
at the end, prior to a final sort.
The following code works fine if the customer name did
not exist previously but fails otherwise.

Also because I sort both lists before doing the search,
is there a quicker way of continuing the search if
nothing is found, see comment in code?

I would be grateful if someone could correct the code
or
for any advice.

T.I.A

Geoff

Code:
Sub aaaa()
Dim rng As Range, rng1 As Range, rng3 As Range
Dim cust As Range, i As Integer, firstFind As String

Set rng = Range("A1")
Set cust = Range("E1")

With Sheets(1)
Set rng1 = .Range(.Range("A1"), .Range("A1:A" & .Range
_
("A65536").End(xlUp).Row))
Set rng3 = .Range(.Range("E1"), .Range("E1:E" & .Range
_
("E65536").End(xlUp).Row))

i = 0
For Each rng In rng1
Set cust = rng3.Find(what:=rng, _
After:=cust, _
SearchDirection:=xlNext)
firstFind = ""
If Not cust Is Nothing Then
Do Until rng.Offset(0, 1) = cust.Offset(0,
1)
Or cust.Address = firstFind
If firstFind = "" Then firstFind =
cust.Address
Set cust = rng3.FindNext(After:=cust)
i = i + 1
Loop
Else
.Range("E" & rng3.Rows.Count + i) = rng
.Range("F" & rng3.Rows.Count + i) =
rng.Offset
(0, 1)
i = i + 1
Set cust = Range("E1") 'Do I have to start
at the beginning if the list is sorted??
End If
Next rng
End With
End Sub



.