PDA

View Full Version : Compare, Copy and Paste using VBA



Shaolin
07-09-2008, 09:41 AM
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.

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

figment
07-09-2008, 10:28 AM
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
07-09-2008, 11:19 AM
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
07-09-2008, 11:55 AM
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


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

Shaolin
07-09-2008, 12:09 PM
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
07-09-2008, 12:18 PM
Check out the Split function


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

Shaolin
07-09-2008, 12:33 PM
Do I even need to use the split function?

:think:

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.

:thumb

mdmackillop
07-09-2008, 12:43 PM
You don't need to find all occurences, so the FindNext procedure is not required


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

Shaolin
07-09-2008, 01:01 PM
great, but how come the copy does not work?

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

:help

mdmackillop
07-09-2008, 01:12 PM
c.Offset(, -1).Resize(, 70).Copy Tgt

Shaolin
07-09-2008, 02:59 PM
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
07-09-2008, 03:16 PM
Can you post your workbook?

Shaolin
07-14-2008, 11:47 AM
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
07-14-2008, 12:11 PM
A wee error in your code that I didn't notice.
Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
If you have such problems, add in a debug line such as

Rng.Select

to see what you are actually working with.

Shaolin
07-14-2008, 12:28 PM
WOW thanks

What did that '1' do?

mdmackillop
07-14-2008, 12:31 PM
"2" looks up column 2, "1" looks up column 1
Add rng.select and step through your code to see the effect.

Shaolin
07-15-2008, 06:01 AM
I see now. Thanks a bunch

:bow:

karldou
07-31-2008, 05:20 AM
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
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

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

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
07-31-2008, 05:59 AM
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

karldou
08-01-2008, 05:50 AM
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

mdmackillop
08-01-2008, 08:05 AM
What i need is when the match is found in the original list, for it to be highlighted yellow.


You are only finding one cell in each loop. Do you want to highlight the cells you are copying?