could someone help me witht his macro please.

M

Michael A

Ok, here is my problem, this macro is supposed to compare the first 3 columns
of one page and the first 3 of the other page, and if it finds any matches of
the first 3 columns , its poplulates what is in the G column on the previous
page to the new page. My problem is, it catches some things, but not other
things. My VB is miserable, so any help tweaking this would be greatly
appreciated, thanks!


Option Explicit

Sub put_next_to_list()
Dim rng As Range
Dim r1 As Long
Dim r2 As Long
Dim r3 As Long
Dim cell As Variant
Dim FR As Long 'first row
Dim LR As Long 'last row
Dim i As Long
Dim ssh As Object 'source sheet
Dim tsh As Object 'target sheet

Set ssh = Sheets(9)
Set tsh = Sheets(10)

FR = 1
LR = tsh.Cells(65536, 1).End(xlUp).Row
Set rng = tsh.Range(tsh.Cells(FR, 1), tsh.Cells(LR, 1))

For Each cell In rng
On Error Resume Next
r1 = 0: r2 = 0: r3 = 0
r1 = ssh.Columns(1).Find(cell.Offset(0, 0)).Row
r2 = ssh.Columns(2).Find(cell.Offset(0, 1)).Row
r3 = ssh.Columns(3).Find(cell.Offset(0, 2)).Row
If r1 = 0 Or r1 <> r2 Or r1 <> r3 Then
Else: cell.Offset(0, 6) = ssh.Cells(r1, 7)
End If
Next cell
End Sub
 
M

Michael A

ok, i think i might know part of the problem, but i am unsure on how to fix
it. some of the columns have text in them. Does anyone know if this would
cause issues?
 
D

Dave Peterson

This is the portion that does all the work.

For Each cell In rng
On Error Resume Next
r1 = 0: r2 = 0: r3 = 0
r1 = ssh.Columns(1).Find(cell.Offset(0, 0)).Row
r2 = ssh.Columns(2).Find(cell.Offset(0, 1)).Row
r3 = ssh.Columns(3).Find(cell.Offset(0, 2)).Row
If r1 = 0 Or r1 <> r2 Or r1 <> r3 Then
Else: cell.Offset(0, 6) = ssh.Cells(r1, 7)
End If
Next cell

And by setting r1, r2, r3 to 0 and turning off error checking, it does a find to
see if there's a match in column A of each sheet, or if there's a match in
column B of each sheet or column C of each sheet.

But if you have duplicate information in column any of the columns, it could
give you trouble.

For instance, say you have x, y, z in row 1 of the tsh worksheet (sheets(10)).

and ssh (sheets(9)) has this in it.

r a b c
- - - -
1 j k l
2 j k l
3 j k l
4 j y l
5 j k z
6 x y z

r1 will be 6 (since X was found in row 6)
r2 will be 4 (since y was found in row 4)
r3 will be 5 (since z was found in row 5)

So the portion that checks the values of r1, r2, r3
(slightly rewritten--but the logic didn't change)
If r1 = 0 Or r1 <> r2 Or r1 <> r3 Then
'do nothing
Else
cell.Offset(0, 6) = ssh.Cells(r1, 7)
End If

Will say that a match of all three values didn't occur on the same row.

The other thing that may cause trouble is that Find will remember the last
parameters that you used--either manually in excel or in code.

So if you looked for matchcase:=true, your code has to find an exact match. If
you looked for xlpart, your code is looking for a string in the cell--not a
match for the whole cell.

If you're looking to return the value from column G when all three cells in the
same row match the three cells in the other sheet (still the same row), maybe
this'll work better:

Option Explicit
Sub put_next_to_list2()

Dim TargetRng As Range
Dim myCell As Range
Dim SourceWks As Worksheet
Dim TargetWks As Worksheet
Dim res As Variant
Dim SourceRng As Range
Dim myFormula As String
Dim BringBack As Variant

Set SourceWks = Worksheets("sheet2") 'Sheets(9)
Set TargetWks = Worksheets("sheet1") 'Sheets(10)

With TargetWks
Set TargetRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With SourceWks
Set SourceRng = .Range("a1:c" & _
.Cells.SpecialCells(xlCellTypeLastCell).Row)
End With

For Each myCell In TargetRng.Cells

With myCell
myFormula = "Match(1,((" & .Address(external:=True) & "=" & _
SourceRng.Columns(1).Address(external:=True) & ")" & _
"*(" & .Offset(0, 1).Address(external:=True) & "=" _
& SourceRng.Columns(2).Address(external:=True) & ")" _
& "*(" & .Offset(0, 2).Address(external:=True) & "=" _
& SourceRng.Columns(3).Address(external:=True) & _
")),0)"

res = Application.Evaluate(myFormula)
If IsError(res) Then
BringBack = "no match"
Else
BringBack = SourceWks.Cells(res, 7).Value
End If
.Offset(0, 6).Value = BringBack
End With
Next myCell
End Sub

That long myFormula is the same as this in a worksheet cell:

=MATCH(1,((Sheet1!$A$2=Sheet2!$A$1:$A$8)
*(Sheet1!$B$2=Sheet2!$B$1:$B$8)
*(Sheet1!$C$2=Sheet2!$C$1:$C$8)), 0)

(ctrl-shift-enter since it's an array formula, though)

This returns the row of the first match of all three columns A:C with what's in
A:C of that row.

If they don't have to match "row-by-row, cell-by-cell", ignore this post.
 
M

Michael A

Dave thankyou for responding and helping me with this. I will try it out and
get back to you. As you can see by the original code, im definately a newbie
with this stuff.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top