Solved: Code stops?

[Gil]

The following code runs and finds the data I want but stops. Chewed on it for a couple of days and am now stuck.
I have attached a zip with 2 files in to demonstrate where it stops
Any help would be appreciated.


Option Explicit
Sub GetthemDON()
Dim lngLastRow As Long
Dim Sh As Worksheet
Dim Fnd As Range

Dim cel As Range

Workbooks("FindWhere.XLS").Activate
lngLastRow = Range("C" & Rows.Count).End(xlUp).Row
Set cel = Cells(lngLastRow, 3)

Workbooks("FindHere.XLS").Activate
Sheets("Green BP").Select

Do

Set Sh = Sheets("Green BP")
Set Fnd = Sh.Cells.Find((Split(cel)(0)), LookAt:=xlWhole)
If Not Fnd Is Nothing Then
cel.Offset(, 1) = Sh.Cells(3, Fnd.Column) & "-" & Sh.Cells(Fnd.Row, 2) & "-" & Sh.Cells(Fnd.Row, 1)
Else
cel.Offset(0, 1) = "Not found1"
End If
If cel.Row = 1 Then Exit Do
If cel.Offset(-1) <> "" Then
Set cel = cel.Offset(-1)
Else
Set cel = cel.End(xlUp)
End If
Loop


Workbooks("FindWhere.XLS").Activate
lngLastRow = Range("G" & Rows.Count).End(xlUp).Row
Set cel = Cells(lngLastRow, 7)

Workbooks("FindHere.XLS").Activate
Sheets("Green EQ").Select

Do

Set Sh = Sheets("Green EQ")
Set Fnd = Sh.Cells.Find((Split(cel)(1)), LookAt:=xlWhole)
If Not Fnd Is Nothing Then
cel.Offset(, 1) = Sh.Cells(3, Fnd.Column) & "-" & Sh.Cells(Fnd.Row, 2) & "-" & Sh.Cells(Fnd.Row, 1)
Else
cel.Offset(0, 1) = "Not found2"
End If
If cel.Row = 1 Then Exit Do
If cel.Offset(-1) <> "" Then
Set cel = cel.Offset(-1)
Else
Set cel = cel.End(xlUp)
End If
Loop

Workbooks("FindWhere").Activate
End Sub

[nilem]

try this
.........
If cel.Offset(-1) <> "" Then
Set cel = cel.Offset(-1)
Else
Set cel = cel.End(xlUp)
End If
If cel.Row = 1 Then Exit Do '!!!!!!!!!!!!
Loop

Workbooks("FindWhere").Activate
End Sub

[Gil]

Hello nilem
It worked a treat. Many thanks for your help.
Gil