Find

[Geoff]

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

 

[shockley]

This is how I would do it. I'm assuming that no customer is listed twice in
the "archived" column:

Sub Tester()
LastRow1 = Cells(65536, 1).End(xlUp).Row
For i = 1 To LastRow1
NewCust = Cells(i, 1)
Set rngFind = Columns(5).Find(NewCust)
If Not rngFind Is Nothing Then
Cells(rngFind.Row, 6) = Cells(i, 2)
Else
LastRow5 = Cells(65536, 5).End(xlUp).Row
Cells(LastRow5 + 1, 5) = Cells(i, 1)
Cells(LastRow5 + 1, 6) = Cells(i, 2)
End If
Next i
End Sub

HTH,
Shockley

 

[Bernie Deitrick]

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]

shockley,
Thank you, but customers do have several locations. Your
example seems to record the last instance of the customer
but not all.
Still working on it.
Please see reply to Bernie Deitrick
Geoff

 

[Geoff]

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

 

[Bernie Deitrick]

Geoff,

You're right, I failed to take into consideration the case with three
or more values of the first key.

The corrected code below _should_ work. Give it a try and let me know.
It worked with my limited test case.

HTH,
Bernie

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

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))


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

 

[Geoff]

Bernie,
What a relief. It works. The solution contains
interesting features to me such as the short notation .End
(xlUp)(2) and rng3(1) plus a neat way of checking for
duplications.
Thank you for staying with it, I'm very grateful.

Geoff

 

[Bernie Deitrick]

Geoff,

What a relief. It works.

Glad to hear it.

The solution contains
interesting features to me such as the short notation .End
(xlUp)(2) and rng3(1) plus a neat way of checking for
duplications.

The short notation is actually short for Cells: for example,
..End(xlUp)(2) is really .End(xlUp).Cells(2,1), or the cell in the second
row of the first column of the range starrting at the cell found by the
..End(xlUp). There are a lot of neat things to learn about Excel.

Thank you for staying with it, I'm very grateful.

You're quite welcome. It's always nice to hear of the success stories.

Bernie