S
saman110 via OfficeKB.com
Hello all.
The macro below compares col. A of compare and master sheet with each other
and then copy and pastes the corresponding cells.
The problem is it copies and pastes the first match that it finds. Is there
any way to copy and paste all the matches below each other? here is what I
mean.
compare sheet.
A B C D
sam 1 10 100
sam 2 20 200
sam 3 30 300
sam 4 40 400
Tom 5 6 7
Master sheet.
A B C D
Sam
Sam
Tom
Compare sheet after running the program.
A B C D
Sam 1 10 100
Sam 2 20 200
3 30 300
4 40 400
Tom 5 6 7
Here is my VBA Without pasting all matches.
Option Explicit
Sub CopyIDData()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim res As Variant
With Worksheets("Compare")
Set rng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
With Worksheets("Master")
Set rng1 = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
For Each cell In rng.Cells
If cell.Value = "" Then
'skip it
Else
res = Application.Match(cell, rng1, 0)
If Not IsError(res) Then
rng1(res, 2).Resize(1, 3).Copy Destination:=cell.Offset(0, 1)
End If
End If
Next cell
End Sub
'Thank you.
The macro below compares col. A of compare and master sheet with each other
and then copy and pastes the corresponding cells.
The problem is it copies and pastes the first match that it finds. Is there
any way to copy and paste all the matches below each other? here is what I
mean.
compare sheet.
A B C D
sam 1 10 100
sam 2 20 200
sam 3 30 300
sam 4 40 400
Tom 5 6 7
Master sheet.
A B C D
Sam
Sam
Tom
Compare sheet after running the program.
A B C D
Sam 1 10 100
Sam 2 20 200
3 30 300
4 40 400
Tom 5 6 7
Here is my VBA Without pasting all matches.
Option Explicit
Sub CopyIDData()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim res As Variant
With Worksheets("Compare")
Set rng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
With Worksheets("Master")
Set rng1 = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
For Each cell In rng.Cells
If cell.Value = "" Then
'skip it
Else
res = Application.Match(cell, rng1, 0)
If Not IsError(res) Then
rng1(res, 2).Resize(1, 3).Copy Destination:=cell.Offset(0, 1)
End If
End If
Next cell
End Sub
'Thank you.