PDA

View Full Version : Lookup on two values and copy cells when match found



danlu
11-11-2009, 08:28 AM
Hi,

I want to look up two values and when found these should be copied together with all info existing on the row of the matched cells to another sheet.

In my lookup sub is used a "For Each" and "offset" tecnique to do the processing of finding a match and then also a match on the cell to the right of the first match.
If a match is found it should pass the cell contained in variable "a" (the cell which is currently processed by the For each statement) to the second sub called Macro1. But when trying to run this I encounter "runtime error 424 - obejct required" so the second sub doesn't seem to recieve the input value "a" from sub mylookup correctly. What correction could be needed in order to make that work?

Sub mylookup()
'For the lookuparea, just enter the column where you have look for the first match,
'that is, the column containing the "a" values.
Dim a As Range
Dim c As Range
Set c = Range("F1")
For Each a In Worksheets(1).Range("A1:A10").Cells
If a.Value = c.Value Then If a.Offset(0, 1).Value = c.Offset(0, 1).Value Then Macro1 (a)
Next
End Sub

Sub Macro1(ByVal cell_in_row As Range)
cell_in_row.EntireRow.Copy
'cannot mark a row. Should mark an individual cell. The "EntireRow" command will cater for 'copying the complete row.
With Sheets(2)
.Rows(.Range("A" & .Rows.Count) _
.End(xlUp).Row) _
.Insert 'finds the first non populated row and paste the copied contents into this row.
End With
End Sub

Bob Phillips
11-11-2009, 08:44 AM
Sub mylookup()
'For the lookuparea, just enter the column where you have look for the first match,
'that is, the column containing the "a" values.
Dim nRow As Long
On Error Resume Next
nRow = ActiveSheet.Evaluate("MATCH(1,(A1:A10=F1)*(B1:B10=G1),0)")
On Error GoTo 0
If nRow > 0 Then

Call Macro1(Range("A1:A10").Cells(nRow, 1).EntireRow)
End If
End Sub

Sub Macro1(ByVal cell_in_row As Range)

'cannot mark a row. Should mark an individual cell. The "EntireRow" command will cater for 'copying the complete row.
With Sheets(2)
cell_in_row.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
End Sub

danlu
11-12-2009, 12:31 AM
Hi,

Thanks for your help. My final goal is to extend this and that is why I am keen on using For each. I tried to modify it to:

Sub mylookup()
'For the lookuparea, just enter the column where you have look for the first match,
'that is, the column containing the "a" values.
Dim a As Range
Dim c As Range
Set c = Range("F1")
For Each a In Worksheets(1).Range("A1:A10").Cells
If a.Value = c.Value Then If a.Offset(0, 1).Value = c.Offset(0, 1).Value Then a.Select: Call Macro1(Selection)
Next
End Sub

Sub Macro1(ByVal cell_in_row As Range)
cell_in_row.EntireRow.Copy
With Sheets(4)
.Rows(.Range("A" & .Rows.Count) _
.End(xlUp).Row) _
.Insert 'finds the first non populated row and paste the copied contents into this row.
End With
End Sub


Which makes the second sub accept the input from the first. But something goes wrong in the For each. It should only do a copy when it gest an actual match, now it seems to copy also for rows which do not match the values in cell F1 and G1. How shoould the evaluation logic of the For each be set up to make it do the evaluation correctly?

Bob Phillips
11-12-2009, 01:46 AM
If a.Value = c.Value And a.Offset(0, 1).Value = c.Offset(0, 1).Value Then
a.Select
Call Macro1(Selection)
End If

danlu
11-12-2009, 04:26 AM
Great that did the trick. My plan was to use to IFs in ordrr to make a stepwise evaluation, that is, if "a" has a match then go on and evaluate if the cell next to "a" so see if that also matches the corresponding cell in the lookuparea. But with "and" it seems to cater this also


Sub mylookup()
'For the lookuparea, just enter the column where you have look for the first match,
'that is, the column containing the "a" values.
Dim a As Range
Dim c As Range
Set c = Range("F1")
For Each a In Worksheets(1).Range("A1:A10").Cells
If a.Value = c.Value And a.Offset(0, 1).Value = c.Offset(0, 1).Value Then
a.Select
Call Macro1(Selection)
End If
Next
End Sub

Sub Macro1(ByVal cell_in_row As Range)
cell_in_row.EntireRow.Copy
With Sheets(6)
.Rows(.Range("A" & .Rows.Count) _
.End(xlUp).Row) _
.Insert 'finds the first non populated row and paste the copied contents into this row.
End With
End Sub

Bob Phillips
11-12-2009, 04:32 AM
You could do it step-wise, just a different syntax



If a.Value = c.Value Then

If a.Offset(0, 1).Value = c.Offset(0, 1).Value Then

a.Select
Call Macro1(Selection)
End IF
End If

danlu
11-18-2009, 01:41 AM
Ok thanks for your input.

danlu
11-18-2009, 01:51 AM
What the first sub (mylookup() ) to go through the cells specified in that sub and evalute each cell against what is defined in sub "secondlookup". If match occurs it should select the cell matched in sub "secondlookup" and pass this cell to the third sub Macro1.
But I always run into error message:
Run-time error '1004':
Select method of Range class failed.

So for some reason it doesn't manage to select cell b. What to do to make VBA recognize the cell in column A on Sheet 5 where a match is found and pass that cell to sub Macro1?


Sub mylookup()
Dim a As Range
For Each a In Worksheets(1).Range("A1:A10").Cells
Call secondlookup(a, a.Offset(0, 1))
Next
End Sub
Sub secondlookup(ByVal e As Range, ByVal f As Range)
Dim b As Range
For Each b In Worksheets(5).Range("A1:A10").Cells
If b.Value = e.Value And b.Offset(0, 1).Value = f.Value Then
b.Select
Call Macro1(Selection): Exit Sub
End If
Next
End Sub



Sub Macro1(ByVal cell_in_row As Range)
Range(cell_in_row, cell_in_row.End(xlToRight)).Copy
With Sheets(6)
.Rows(.Range("A" & .Rows.Count) _
.End(xlUp).Row) _
.Insert 'finds the first non populated row and paste the copied contents into this row.
End With
End Sub