loop thru cells to find matching record

  • Thread starter Thread starter burl_h
  • Start date Start date
B

burl_h

I'm having difficulty with the following code.

I think thre are several issues, perhaps the easier one first.
When I set the following range, I noticed it didn't start at row 14
but at row 12, not sure why?
Set rng = wsSheet.Range("A14:A" & Cells(65536, "A").End(xlUp).Row). I
noticed that the message box shows cells I'm not interested in.

The more difficult problem is per the following
The active workbook, "sheet 1" has a lising of serial numbers, the
serial numbers start at row 14, the exact number varies, hence the set
rng as per above. These are unique serial numbers (no duplicates)

The intent is that the serial number listed in the active workbook
(sheet 1) is found on the second workbook
123456.xls sheet "side 1". The 123456.xls sheet "side 1" has been
sorted by serial number and a date and time column, as I want to
ultimetely select the most recent recording of a serial number
(duplicate serial numbers may exist), this puts the most recent at the
bottom of each serial number grouping.

All I want to accomplish is get the value in the adjacent cell of the
matching serial number from the 123456.xls "sheet 1", however it must
be the latest record of the serial number we are trying to find. The
adjacent value is then placed in the adjacent cell from the active
workbook "sheet 1". We then select the next serial number to find from
active workbook "sheet 1" and repeat the routine until all serial
numbers in active workbook "sheet 1" have been processed.

Many thanks
burl_h


Sub Update()

Dim wsDest As Worksheet
Dim Dest As Workbook
Dim wsSheet As Worksheet
Dim tofind As Range
Dim rng As Range
Dim rng1 As Range

Set wsSheet = ActiveWorkbook.Sheets("Sheet1")
Set Dest = Workbooks.Open("F:\Test Data\Macro Files\123456.xls")
Set wsDest = Dest.Worksheets("Side_1")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set rng = wsSheet.Range("A14:A" & Cells(65536, "A").End(xlUp).Row)
For Each cell In rng
Set tofind = cell
If (tofind.Value <> "") Then
With wsDest.Range("B:B")
Set rng1 = .Find(what:=tofind, after:=Range("B1"),
LookIn:=xlFormulas, _
lookat:=xlPart, searchorder:=xlByRows,
Searchdirection:=xlPrevious, _
MatchCase:=False)
If Not rng1 Is Nothing Then
If rng1.Offset(1, 0) = tofind Then
Set rng1 = .FindNext(rng1)
Else
tofind.Offset(0, 1) = rng1.Offset(0, 2)
End If
Else
MsgBox "nothing found"
End If
End With
End If
Next cell

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
I have not tested your code but try the following alterations. I think your
Set rng should work but try the following which is my preference for the
code. (Note a space and underscore at the end of a line is a line break in an
otherwise single line of code.)

With wsSheet
Set rng = .Range(.Cells(14, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With

In your find, need to specify the worksheet for the After parameter;
otherwise VBA assumes B1 is referring to whatever is the active sheet.

After:=wsDest.Range("B1")

Is parameter Lookat:=xlPart correct? Should it not be xlWhole?

Also there is no need to reassign cell to another variable. See example
below where you can use cell.value without reassigning.

For Each cell In rng
If (cell.Value <> "") Then
With wsDest.Range("B:B")
Set rng1 = .Find(what:=cell.Value, _
after:=wsDest.Range("B1"), _
LookIn:=xlFormulas, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
Searchdirection:=xlPrevious, _
MatchCase:=False)


If Not rng1 Is Nothing Then
If rng1.Offset(1, 0) = cell.Value Then
Set rng1 = .FindNext(rng1)
Else
cell.Offset(0, 1) = rng1.Offset(0, 2)
End If
Else
'Better to specify what was not found.
MsgBox "nothing found for " & cell.Value
'MsgBox "nothing found"
End If
End With
End If
Next cell
 
OssieMac,

Your solution worked great, thank so much for the assistance.

What would the novice programmers like I do without this kind of help,
again many thanks

burl_h
 
Back
Top