Find match between cells and copy data

[Kcope8302]

I am looking for a method to compare column A in to worksheets. I would like
a Macro if possible but any method would work at this point. Once a match is
found it would copy 4 cells from that line into another worksheet.

The macro will look at column A between 2
worksheets (PTR and Reference Data). If what is in column A in Reference Data
worksheet matches Column A in PTR it will then copy 4 cells from that
row(L,M,N and O) and paste them in the PTR worksheet(W,X,Y,Z)

Example
PTR – Before the Macro
A .......... W X Y
Z
CR94875


Reference Data - Data that would need to be copied if a match is found
A ………. L M N O
CR94875 TBD On-Time 5/25/09 Source List


PTR – After a match was found in column A
A .......... W X Y
Z
CR94875 TBD On-Time 5/25/09 Source List

 

[Atishoo]

try this (think I got my offsets right not tested it)
Private Sub CommandButton1_Click()

For Each c In Worksheets("ReferenceData").Range("A:A")
If c.Value <> "" Then
If c.Value = Worksheets("PTR").Range(c.Address) Then

With Worksheets("PTR")
.Range(c.Address).Offset(0, 23) =
Worksheets("referencedata").Range(c.Address).Offset(0, 12)
.Range(c.Address).Offset(0, 24) =
Worksheets("referencedata").Range(c.Address).Offset(0, 13)
.Range(c.Address).Offset(0, 25) =
Worksheets("referencedata").Range(c.Address).Offset(0, 14)
.Range(c.Address).Offset(0, 26) =
Worksheets("referencedata").Range(c.Address).Offset(0, 15)
End With

End If
End If
Next

End Sub

 

[Kcope8302]

It is stating there is a compile syntax error. All of the lines starting with
'.Range' are in red. To verify I was to take this and put it in VB in a
standard module correct? I understand the basics of what you sent but can not
see why it is having issues. I can send a copy of the report if that is
possible.

Thanks

 

[Kcope8302]

This is the current macro that I am using. This would work if it would paste
starting at W and not the entire row. The specific line that has been causing
me issues was line 9.

Line: oCell.EntireRow.Copy Destination:=Sheets("PTR").Range("W" &
Rows.Count).End(xlUp).Offset(1, 0)

This line should paste all of the reference data line into PTR starting at
W. Can you assist with this?

Sub Copy2()

Dim Rng As Range, Rng1 As Range, MyCell As Range, oCell As Range, i As Long
Set Rng = Sheets("Reference Data").Range("A1:A" & Sheets("Reference
Data").Range("A" & Rows.Count).End(xlUp).Row)
Set Rng1 = Sheets("PTR").Range("A1:A" & Sheets("PTR").Range("A" &
Rows.Count).End(xlUp).Row)
i = 0
For Each MyCell In Rng1
For Each oCell In Rng
If oCell.Value = MyCell.Value Then
oCell.EntireRow.Copy Destination:=Sheets("PTR").Range("W" &
Rows.Count).End(xlUp).Offset(1, 0)
i = i + 1
End If
Next oCell
Next MyCell
i = 0
' Referencedata Macro
'
' Keyboard Shortcut: Ctrl+b

End Sub

 

[Francis]

try

Sub test()

Dim c As Variant

For Each c In Worksheets("ReferenceData").Range("A:A")
If c.Value <> "" Then
If c.Value = Worksheets("PTR").Range(c.Address) Then

With Worksheets("PTR")
..Range(c.Address).Offset(0, 23) =
Worksheets("referencedata").Range(c.Address).Offset(0, 12)
..Range(c.Address).Offset(0, 24) =
Worksheets("referencedata").Range(c.Address).Offset(0, 13)
..Range(c.Address).Offset(0, 25) =
Worksheets("referencedata").Range(c.Address).Offset(0, 14)
..Range(c.Address).Offset(0, 26) =
Worksheets("referencedata").Range(c.Address).Offset(0, 15)
End With

End If
End If
Next

End Sub


Beware of text wrap. eg the following is in one line
..Range(c.Address).Offset(0, 23) =
Worksheets("referencedata").Range(c.Address).Offset(0, 12)

--
Hope this is helpful

Pls click the Yes button below if this post provide answer you have asked

Thank You

cheers, francis

 

[Atishoo]

It works fine (except I got my offsets advanced by 1) when you paste it in
make sure the
..Range(c.Address).Offset(0, 23) =
Worksheets("referencedata").Range(c.Address).Offset(0, 12)
is all continuous on one line not split.

 

[Kcope8302]

It did run this time but did not populate. Which variable takes into account
PTR worksheets A column for the comparison?

Line: If c.Value = Worksheets("PTR").Range(c.Address)

Does (c.Address) assume it is looking in the A column of PTR worksheet?

Thanks

 

[Atishoo]

Hi have written it out in long hand as follows have also taken the time to
write it in excell and check it!
In answer to your question the first line starts checking through all cells
in column a in referencedata the second line ignores empty cells and the
third line checks if the value in c (c being the cell being checked) is equal
to the cell in the worksheet PTR bearing the same address as the cell being
checked (c.address).

For Each c In Worksheets("ReferenceData").Range("A:A")
If c.Value <> "" Then
If c.Value = Worksheets("PTR").Range(c.Address) Then

Worksheets("PTR").Range(c.Address).Offset(0, 22).Value =
Worksheets("referencedata").Range(c.Address).Offset(0, 11).Value
Worksheets("PTR").Range(c.Address).Offset(0, 23).Value =
Worksheets("referencedata").Range(c.Address).Offset(0, 12).Value
Worksheets("PTR").Range(c.Address).Offset(0, 24).Value =
Worksheets("referencedata").Range(c.Address).Offset(0, 13).Value
Worksheets("PTR").Range(c.Address).Offset(0, 25).Value =
Worksheets("referencedata").Range(c.Address).Offset(0, 14).Value


End If
End If
Next