Help - I am trying to search a range row by row and find
the matching item in another range and then compare some
data in adjacent columns, and then if ok copy some other
data from one sheet to the next. I am getting an error
"object variable or With block variable not set" on the
if iserror statement - which is inteded to determine if
the item is missing from the second range.

thanks,

John

Option Explicit
Sub Compare()
'
Dim badbatch(100)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim nomrow As Integer
Dim startkm As Integer
Dim numkm As Integer
Dim startnom As Integer
Dim colnom As Integer
Dim colkm As Integer
Dim km As Range
Dim nom As Range
Dim tender As String
'
' Define ranges
'
Range("km").CurrentRegion.Name = "km"
Range("nom").CurrentRegion.Name = "nom"
numkm = Range("km").End(xlDown).Row - Range("km").Row
startkm = Range("km").Row
colkm = Range("km").Column
startnom = Range("nom").Row
colnom = Range("nom").Column
i = 0
For j = startkm To numkm + startkm
Sheets("km").Select
tender = Sheets("km").Cells(j, colkm).Text
If IsError(Sheets("nominated").Range("nom").Find
(tender).Row) _
Then GoTo badtender
nomrow = Sheets("nominated").Range("nom"). _
Find(Sheets("km").Cells(j, colkm).Text).Row
If Sheets("km").Cells(j, colkm).Offset(0, 4).Value < _
Sheets("nominated").Cells(nomrow, colnom + 4).Value _
Then GoTo badvolume
Sheets("nominated").Cells(nomrow, colnom + 2) = _
Sheets("km").Cells(j, colkm).Offset(0, 2).Value
Sheets("nominated").Cells(nomrow, colnom + 3) = _
Sheets("km").Cells(j, colkm).Offset(0, 3).Value
GoTo nextj
badvolume:
i = i + 1
badbatch(i) = Cells(j, colkm).Text
GoTo nextj
badtender:
i = i + 1
badbatch(i) = Cells(j, colkm).Text
GoTo nextj
nextj:
Next j
If i 0 Then MsgBox ("Batch not found") Else GoTo done
Sheets("badtenders").Select
For k = 1 To i
Cells(k + 1, 1).Value = badbatch(k)
Cells(2, 5).Value = startkm
Cells(2, 6).Value = numkm
Next k
done:
End Sub

find doesn't return an error, so it can't be tested with iserror. Trying to
get the row property of the result could produce an error, but that error
can't be checked with iserror - you would have to use error handling.
Easier is to do this

Dim rng as Range
set rng = Sheets("nominated").Range("nom").Find(tender))
if rng is nothing then
msgbox "Not found"
Else
' now you can use rng to work with the found cell
lngrow = rng.Row
End if

--
Regards,
Tom Ogilvy



"John" wrote in message
...
Help - I am trying to search a range row by row and find
the matching item in another range and then compare some
data in adjacent columns, and then if ok copy some other
data from one sheet to the next. I am getting an error
"object variable or With block variable not set" on the
if iserror statement - which is inteded to determine if
the item is missing from the second range.

thanks,

John

Option Explicit
Sub Compare()
'
Dim badbatch(100)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim nomrow As Integer
Dim startkm As Integer
Dim numkm As Integer
Dim startnom As Integer
Dim colnom As Integer
Dim colkm As Integer
Dim km As Range
Dim nom As Range
Dim tender As String
'
' Define ranges
'
Range("km").CurrentRegion.Name = "km"
Range("nom").CurrentRegion.Name = "nom"
numkm = Range("km").End(xlDown).Row - Range("km").Row
startkm = Range("km").Row
colkm = Range("km").Column
startnom = Range("nom").Row
colnom = Range("nom").Column
i = 0
For j = startkm To numkm + startkm
Sheets("km").Select
tender = Sheets("km").Cells(j, colkm).Text
If IsError(Sheets("nominated").Range("nom").Find
(tender).Row) _
Then GoTo badtender
nomrow = Sheets("nominated").Range("nom"). _
Find(Sheets("km").Cells(j, colkm).Text).Row
If Sheets("km").Cells(j, colkm).Offset(0, 4).Value < _
Sheets("nominated").Cells(nomrow, colnom + 4).Value _
Then GoTo badvolume
Sheets("nominated").Cells(nomrow, colnom + 2) = _
Sheets("km").Cells(j, colkm).Offset(0, 2).Value
Sheets("nominated").Cells(nomrow, colnom + 3) = _
Sheets("km").Cells(j, colkm).Offset(0, 3).Value
GoTo nextj
badvolume:
i = i + 1
badbatch(i) = Cells(j, colkm).Text
GoTo nextj
badtender:
i = i + 1
badbatch(i) = Cells(j, colkm).Text
GoTo nextj
nextj:
Next j
If i 0 Then MsgBox ("Batch not found") Else GoTo done
Sheets("badtenders").Select
For k = 1 To i
Cells(k + 1, 1).Value = badbatch(k)
Cells(2, 5).Value = startkm
Cells(2, 6).Value = numkm
Next k
done:
End Sub

Thank you Tom....

-----Original Message-----
find doesn't return an error, so it can't be tested with
iserror. Trying to
get the row property of the result could produce an
error, but that error
can't be checked with iserror - you would have to use
error handling.
Easier is to do this

Dim rng as Range
set rng = Sheets("nominated").Range("nom").Find(tender))
if rng is nothing then
msgbox "Not found"
Else
' now you can use rng to work with the found cell
lngrow = rng.Row
End if

--
Regards,
Tom Ogilvy



"John" wrote in
message
...
Help - I am trying to search a range row by row and find
the matching item in another range and then compare some
data in adjacent columns, and then if ok copy some other
data from one sheet to the next. I am getting an error
"object variable or With block variable not set" on the
if iserror statement - which is inteded to determine if
the item is missing from the second range.

thanks,

John

Option Explicit
Sub Compare()
'
Dim badbatch(100)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim nomrow As Integer
Dim startkm As Integer
Dim numkm As Integer
Dim startnom As Integer
Dim colnom As Integer
Dim colkm As Integer
Dim km As Range
Dim nom As Range
Dim tender As String
'
' Define ranges
'
Range("km").CurrentRegion.Name = "km"
Range("nom").CurrentRegion.Name = "nom"
numkm = Range("km").End(xlDown).Row - Range("km").Row
startkm = Range("km").Row
colkm = Range("km").Column
startnom = Range("nom").Row
colnom = Range("nom").Column
i = 0
For j = startkm To numkm + startkm
Sheets("km").Select
tender = Sheets("km").Cells(j, colkm).Text
If IsError(Sheets("nominated").Range("nom").Find
(tender).Row) _
Then GoTo badtender
nomrow = Sheets("nominated").Range("nom"). _
Find(Sheets("km").Cells(j, colkm).Text).Row
If Sheets("km").Cells(j, colkm).Offset(0, 4).Value < _
Sheets("nominated").Cells(nomrow, colnom + 4).Value _
Then GoTo badvolume
Sheets("nominated").Cells(nomrow, colnom + 2) = _
Sheets("km").Cells(j, colkm).Offset(0, 2).Value
Sheets("nominated").Cells(nomrow, colnom + 3) = _
Sheets("km").Cells(j, colkm).Offset(0, 3).Value
GoTo nextj
badvolume:
i = i + 1
badbatch(i) = Cells(j, colkm).Text
GoTo nextj
badtender:
i = i + 1
badbatch(i) = Cells(j, colkm).Text
GoTo nextj
nextj:
Next j
If i 0 Then MsgBox ("Batch not found") Else GoTo done
Sheets("badtenders").Select
For k = 1 To i
Cells(k + 1, 1).Value = badbatch(k)
Cells(2, 5).Value = startkm
Cells(2, 6).Value = numkm
Next k
done:
End Sub



.

Hi
The attached example will find all rows with nos. 1 to 7 and copy the
results to Sheet2. I would like to modify the code to incorporate 2x
..find criteria that will say only find rows with say 2 & 5 or 1 & 7 .
I would appreciate any suggestions - can this be done?

Sub CopyFoundRows()
Dim FoundCell As Range, CopyMe As Range, Rng As Range
Dim FirstAddress As String
Dim Num As Long
Dim StartCel$, EndCel$

Range("A1").Select
StartCel = ActiveCell.Address
EndCel = ActiveCell.End(xlToRight).End(xlDown).Address

Num = 0
For xFind = 1 To 7
Num = Num + 1
Set Rng = Range((StartCel), (EndCel))
With Rng
Set FoundCell = .Find(Num, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlDown)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address

Do
If CopyMe Is Nothing Then
Set CopyMe = FoundCell
Else
Set CopyMe = Union(FoundCell, CopyMe)
End If
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address < FirstAddress
End If
End With

If CopyMe Is Nothing Then
Else
End If

CopyMe.Select
With Selection
.EntireRow.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End With

Range("A65536").End(xlUp).Offset(3, 0).Select
Sheets("Sheet1").Select
Set CopyMe = Nothing

Next

End Sub

TIA

LMB

Hi
There was no response to the above post.
I have however tried another approach to the (2x find criteria)
problem.
Can this be improved? Is there a more efficient method to obtain the
desired results? Any comments, suggestions would be appreciated.

Sample Data - Starting Range ("A2")
1 2 3 4 5 6
7 1 2 3 4 5
6 7 1 2 3 4
5 3 6 7 1 2
4 5 3 6 7 1

I used an index to check how many times the numbers say 2 & 5 or 1 & 7
occurred.


Sub Macro1()
Dim Num1 As Long, Num2 As Long
Dim sCel$, eCel$, iCnt1$, iCnt2$, tRow$, rKfill1$, rKfill2$
Dim Rng As Range, Rng1 As Range
Dim t As Single
t = Timer

Sheets("Sheet2").Select
Range("A1").Select
iCnt1 = 0
iCnt2 = 2
For Label1 = 1 To 6
iCnt1 = iCnt1 + 1
For Label2 = 1 To 6
ActiveCell.Formula = Str$(iCnt1) + Str$(iCnt2)
ActiveCell.Offset(1, 0).Select
iCnt2 = iCnt2 + 1
Next
iCnt2 = 2
ActiveCell.End(xlUp).End(xlUp).Offset(0, 2).Select
Next
Range("B1").Select
Sheets("Sheet1").Select

Num1 = 0
Num2 = 1

Range("A1").Select
tRow = Range(("A2"), Range("A2").End(xlDown)).Rows.Count
sCel = Range("A2").Address
eCel = Range("A2").End(xlToRight).End(xlDown).Address
Set Rng = Range(sCel, eCel)
Set Rng1 = Range(sCel, eCel)
rKfill1 = Range("A2").Offset(0, 10).Address
rKfill2 = Range("A2").End(xlDown).Offset(0, 10).Address

Num1 = Num1 + 1
Num2 = Num2 + 1

For zCnt = 1 To 6
For rCnt = 1 To 6
For Each Cel In Rng
Cells.Find(What:=Num1, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=True) _
.Activate
If ActiveCell = Num1 Then
ActiveCell.End(xlToLeft).Offset(0, 8).Formula = "Foundcell"
End If
Cells.FindNext(After:=ActiveCell).Activate
If ActiveCell = Num1 Then
ActiveCell.End(xlToLeft).Offset(0, 8).Formula = "Foundcell"
End If
Next

Range("A1").Select
For Each Cel In Rng1
Cells.Find(What:=Num2, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=True) _
.Activate
If ActiveCell = Num2 Then
ActiveCell.End(xlToLeft).Offset(0, 9).Formula = "Foundcell"
End If
Cells.FindNext(After:=ActiveCell).Activate
If ActiveCell = Num2 Then
ActiveCell.End(xlToLeft).Offset(0, 9).Formula = "Foundcell"
End If
Next

Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(COUNTIF(RC[-2]:RC[-1],""Foundcell"")=2,""Copy Rng"","""")"
Selection.AutoFill Destination:=Range(rKfill1, rKfill2)
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R[" & Format(-tRow) &
"]C:R[-1]C,""Copy Rng"")"

ActiveCell.Copy
Sheets("Sheet2").Select
ActiveCell.PasteSpecial (xlValues)
ActiveCell.Offset(1, 0).Select

Sheets("Sheet1").Select
Columns("I:K").ClearContents
Range("A1").Select
Num2 = Num2 + 1
Next
Num1 = Num1 + 1
Num2 = 2

Sheets("Sheet2").Select
ActiveCell.End(xlUp).End(xlUp).Offset(0, 2).Select
Sheets("Sheet1").Select
Next

Sheets("Sheet2").Select
Cells.Select
With Selection
.ColumnWidth = 5
.HorizontalAlignment = xlCenter
End With

t = Timer - t
MsgBox "Time " & Format(t, "0.00") & " seconds", vbInformation = t

End Sub



PS - 2nd. Query - With regard to the post dd 26/06/2004 - Would it be
possible to modify the "CopyFoundRows" macro to achieve the same
results.


TIA
LMB