If the eartag can only appear twice, then this clumsy modification will
work:

Sub Tester1()

With Worksheets("Sheet1")
Set rng = .Range(.Cells(2, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
With Worksheets("Sheet2")
Set rng1 = .Range(.Cells(2, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In rng
res = Empty
res = Application.VLookup(cell.Value, _
rng1.Resize(, 16), 2, 0)
If Not IsError(res) Then
cell.Offset(0, 7).Value = _
cell.Offset(0, 7).Value & " " & res
cell.Offset(0, 15).Value = _
Application.VLookup(cell.Value, _
rng1.Resize(, 16), 16, 0)
res1 = Application.Match(cell.Value, _
rng1, 0)
Set rng2 = rng1(res1 + 1)
Set rng2 = rng1.Parent.Range( _
rng2, rng1(rng1.Count))
res2 = Application.VLookup(cell.Value, _
rng2.Resize(, 16), 16, 0)
If Not IsError(res2) Then
cell.Offset(0, 15).Value = _
cell.Offset(0, 15).Value & res2
End If
End If
Next
End Sub

If it can appear more than twice, then I probably would use an entirely
different, more generalized approach.


Regards,
Tom Ogilvy



Gareth wrote in message
...
Tom

Many thanks for this, with a little tweak or two it now works fine.

However I now have another problem, it is possible for the same eartag to
appear twice on Sheet2. I want the value in column P of both rows to
appear
in column P on Sheet1.

For example, UK F2611 00231 may appear twice on Sheet2 with a 'C' and an
'L'
in column P, I would like 'CL' to be displayed in column P on Sheet1 for
UK
F2611 00231.

Can Lookup look for the same value twice?

Gareth

This is the code as it is now:

Sub InsertBandCorL()
Application.ScreenUpdating = False
With Worksheets("Cattle Details")
Set rng = .Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
End With
With Worksheets("Retention Periods")
Set rng1 = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In rng
res = Empty
res = Application.VLookup(cell.Value, rng1.Resize(, 16), 2, 0)
If Not IsError(res) Then
cell.Offset(0, 5).Value = res
cell.Offset(0, 13).Value = Application.VLookup(cell.Value, rng1.Resize(,
16), 16, 0)
End If
Next
Application.ScreenUpdating = True
End Sub