Gil
11-30-2011, 07:52 PM
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
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