Compare, Copy and Paste using VBA

[Shaolin]

I want to compare names from Column A in Sheet1 to Column B in Sheet2 and if the same copy from sheet2 and paste the entire row onto Sheet3.

Help! This compares first and last names - I just need one name. The code is not working.

[VBA]Public Sub MDC_Usage()

'*Use this Macro to compare names from two worksheets and print result in another

'Declaring variables
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim LCel As Range, Nm As Range, c As Range, Tgt As Range
Dim Rng As Range, firstaddress As String

Set Sh1 = Sheets("Users")
Set Sh2 = Sheets("Usage")
Set Sh3 = Sheets("Final")

With Sh1
'Get list of last names from Sh1
Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp))
'Search those last names in Sh2
With Sh2.Columns(2)
For Each Nm In Rng
Set c = .Find(Nm, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
'Check first names
If Nm.Offset(, 0) = c.Offset(, 0) Then
'Get next vacant cell
Set Tgt = Sh3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Copy names
c.Offset(, -2).Resize(, 70).Copy Tgt
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
Next
End With
End With
End Sub
[/VBA]

[figment]

how is the data stored? is first and last name in the same cell? or is one cell first name and the other cell last?

[Shaolin]

how is the data stored? is first and last name in the same cell? or is one cell first name and the other cell last?

First name and last name is in the same cell

All names are typed as "Johnson,Mark"

[figment]

if both names are in the same cell then you need to find the first name in each cell before you can compare them. you can do that using something like the folowing


[VBA]If splitnames(Nm.Value, ",", True) = splitnames(c.Value, ",", tur) Then


Function splitnames(str As String, findstr As String, frounthalf As Boolean) As String
Dim a As Long
For a = 1 To Len(a) - Len(findstr) - 1
If Mid(str, a, Len(findstr)) = findstr Then
If frounthalf Then
splitnames = Left(str, a - 1)
Else
splitnames = Right(str, Len(str) - a - (Len(findstr) - 1))
End If
Exit Function
End If
Next
End Function[/VBA]

[Shaolin]

Thanks!!

well, I don't have to compare first and last names separately. I can just compare the whole name as one entity, since both sheets use the exact same format.

there is a mismatch for 'tur'

[mdmackillop]

Check out the Split function

[vba]
MyNames = Split(Range("A1"), ",")
surname = MyNames(0)
forename = MyNames(1)

[/vba]

[Shaolin]

Do I even need to use the split function?



Can I just compare one cell in column A of sheet1 to the each cell in column B of sheet2? If there is a match, then copy entire row onto sheet 3 and continue to the next cell in column A of sheet 1 to the next cell in column B of sheet2 and copy entire row onto sheet3 and continue.

[mdmackillop]

You don't need to find all occurences, so the FindNext procedure is not required

[VBA]
Public Sub MDC_Usage()
'*Use this Macro to compare names from two worksheets and print result in another
'Declaring variables
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim Nm As Range, c As Range, Tgt As Range
Dim Rng As Range
Set Sh1 = Sheets("Users")
Set Sh2 = Sheets("Usage")
Set Sh3 = Sheets("Final")
With Sh1
'Get list of last names from Sh1
Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp))
'Search those names in Sh2
With Sh2.Columns(2)
For Each Nm In Rng
Set c = .Find(Nm, LookIn:=xlValues)
If Not c Is Nothing Then
Set Tgt = Sh3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Copy names
c.Offset(, -2).Resize(, 70).Copy Tgt
End If
Next
End With
End With
End Sub
[/VBA]

[Shaolin]

great, but how come the copy does not work?

c.Offset(, -2).Resize(, 70).Copy Tgt

[mdmackillop]

[VBA]c.Offset(, -1).Resize(, 70).Copy Tgt [/VBA]

[Shaolin]

Thanks. Now it runs, except it does work properly. It only grabbed one of twenty names and it even pasted a name that was not in sh1.

I am thoroughly confused.

Any suggestions?

[mdmackillop]

Can you post your workbook?

[Shaolin]

OK, I attached the file

It seems as if the loop breaks when a name or two is matched. It's like "hell with it" after matching a name from sheet1 entitled "Usage" and sheet2 entitled "Users"

The output is printed on sheet3 entitled "Final"

Thanks for everything!!

[mdmackillop]

A wee error in your code that I didn't notice.
[VBA]Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))[/VBA]
If you have such problems, add in a debug line such as
[VBA]
Rng.Select
[/VBA]
to see what you are actually working with.

[Shaolin]

WOW thanks

What did that '1' do?

[mdmackillop]

"2" looks up column 2, "1" looks up column 1
Add rng.select and step through your code to see the effect.

[Shaolin]

I see now. Thanks a bunch

[karldou]

Hi mdmackillop, I've been looking for some code that would do a similar operation... and I have managed to slightly edit your code to work with my sheet.. Thanks very much!

There is just one extra thing i would like to do.
What i need is when the match is found in the original list, for it to be highlighted yellow.

Here is the code I am using
[vba]Public Sub Compare_copy()
'*Use this Macro to compare names from two worksheets and print result in another
'Declaring variables
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim Nm As Range, c As Range, Tgt As Range, Tgt2 As Range
Dim Rng As Range

Set Sh1 = Sheets("Sheet6")
Set Sh2 = Sheets("Sheet2")
Set Sh3 = Sheets("Sheet3")

With Sh1
'Get list of last names from Sh1

Set Rng = Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))

'Search those names in Sh2
With Sh2.Columns(3)
For Each Nm In Rng
Set c = .Find(Nm, LookIn:=xlValues)
If Not c Is Nothing Then
Set Tgt = Sh3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Copy names
c.Offset(, -2).Resize(, 70).Copy Tgt
End If
Next
End With
End With
End Sub[/vba]

I also recorded a macro of me highlighting a cell
[vba] With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid[/vba]

I am wondering how I can make the found cells become highlighted in the source sheet (Sheet 6). I was thinking maybe find a way to include an If statement to state, If match, highlight yellow. But unfortunatley I am very new to VBA and I don't quite understand where I can fit this in.

Many thanks
Karl

[mdmackillop]

[VBA]If Not c Is Nothing Then
c.Interior.ColorIndex = 6
Set Tgt = Sh3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Copy names
c.Offset(, -2).Resize(, 70).Copy Tgt
End If[/VBA]

[karldou]

Hi mdmackillop,
I tried the above amendments, however it only highlights the last cell in the column.. not all the cells that were found.
Any ideas?
many thanks
Karl