Excel Macro for match name

[Lillian]

I have one excel spread sheet, on sheet1 (a1:a22), on sheet2 (a1:a28),
sheet 1 (only have columnA with name information)
name
aaa
bbb
ccc
sheet2 (have ColumnA, Columnb, ColumnC)
name OS IPaddress
aaa xp 1.1.2.0
ddd xp 1.1.1.0
ddd 2000 1.2.2.0

how can I match this sheet1 and sheet2 on columnA if not match
then I want to move difference to sheet3 with name, OS, IPaddress
how you do with macro?

Thanks you

Lillian

 

[Jay]

Hi Lillian -

Try this for starters. Let me know if it needs modifications.

Sub Lillian()
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("Lillian1") '<<=== rename to wksheet w/ names only
Set ws2 = Worksheets("Lillian2") '<<=== rename to wksheet w/ names, etc.
ActiveWorkbook.Worksheets.Add after:=Worksheets("Lillian2") '<<==rename
ActiveSheet.Name = "Lillian3" '<<===rename

wsRows = ws1.Rows.Count

ws2.Activate
Range("A1").Activate '<<===Set to top-most cell in name column
Do

If ws1.Range("A1:A" & wsRows).Find(ActiveCell.Value) Is Nothing Then
ActiveCell.EntireRow.Copy Destination:=Worksheets("Lillian3") _
.Range("A" & wsRows).End(xlUp).Offset(1, 0)
End If

ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""

End Sub

 

[Lillian]

Jay:

I use your script and modify like this
Sub Lillian()
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("sheet2")
Set ws2 = Worksheets("sheet3")
ActiveWorkbook.Worksheets.Add after:=Worksheets("sheet2")
ActiveSheet.Name = "sheet3"

wsRows = ws1.Rows.Count

ws2.Activate
Range("A1").Activate
Do

If ws1.Range("A1:A" & wsRows).Find(ActiveCell.Value) Is Nothing Then
ActiveCell.EntireRow.Copy Destination:=Worksheets("sheet3") _
.Range("A" & wsRows).End(xlUp).Offset(1, 0)
End If

ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""

End Sub

and it give me the erroe'1004' can not rename a sheet to the same name as
another sheet, a reference obhect library or workbood referenced by Visual
basic,

my excel name: text.xls, has sheet2 and sheet3 two sheets only

All I need is on the sheet2 only has one columnA of data, if match with
sheet2 on columnA, if sheet3 has more columnsB, and ColumnC, I would like
moved to sheet2

Thanks Jay

Lillian

 

[Jay]

Hi Lillian -

I'm struggling a bit to understand your exact objective, so I've included 3
new versions below:

Lillian1: Makes a new sheet called "output" that lists records for UNMATCHED
names.

Lillian2: Makes a new sheet called "output" that lists records for MATCHED
names.

Lillian3: Looks up data for MATCHED names and displays the data on sheet2.

I think Lillian3 will do what you described in your most recent post.
All three versions assume that the name lists start in cell A1 of sheet2 and
sheet3.
--
Jay
---------------------------------------------------------------------------------------------
Sub Lillian1()
'Writes records for UNMATCHED names to new "output" sheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws As Worksheet

Application.DisplayAlerts = False

Set ws1 = Worksheets("sheet2")
Set ws2 = Worksheets("sheet3")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "output" Then ws.Delete
Next 'ws
ActiveWorkbook.Worksheets.Add after:=Worksheets("sheet3")
ActiveSheet.Name = "output"

wsRows = ws2.Rows.Count

ws2.Activate
Range("A1").Activate

Do
If Not InStr(1, ActiveCell.Value, "name") Then
If ws1.Range("A1:A" & wsRows).Find(ActiveCell.Value, lookat:=xlWhole) Is
Nothing Then
ActiveCell.EntireRow.Copy Destination:=Worksheets("output") _
.Range("A" & wsRows).End(xlUp).Offset(1, 0)
End If

ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""

Application.DisplayAlerts = True

End Sub
'----------------------------------------
Sub Lillian2()
'Writes records for MATCHED names to new "output" sheet

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws As Worksheet

Application.DisplayAlerts = False

Set ws1 = Worksheets("sheet2")
Set ws2 = Worksheets("sheet3")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "output" Then ws.Delete
Next 'ws
ActiveWorkbook.Worksheets.Add after:=Worksheets("sheet3")
ActiveSheet.Name = "output"

wsRows = ws2.Rows.Count

ws1.Activate
Range("A1").Activate

Do
If Not InStr(1, ActiveCell.Value, "name") Then
If Not ws2.Range("A1:A" & wsRows).Find(ActiveCell.Value,
lookat:=xlWhole) Is Nothing Then
ws2.Range("A1:A" & wsRows).Find(ActiveCell.Value,
lookat:=xlWhole).EntireRow.Copy _
Destination:=Worksheets("output").Range("A" &
wsRows).End(xlUp).Offset(1, 0)
End If

ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""

Application.DisplayAlerts = True

End Sub
'----------------------------------------
Sub Lillian3()
'Looks up data for matching names
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws As Worksheet
Dim refrng As Range
Dim f As Range

Set ws1 = Worksheets("sheet2")
Set ws2 = Worksheets("sheet3")

wsRows = ws2.Rows.Count

ws1.Activate
Range("A1").Activate
Set refrng = ws2.Range("A1:A" & wsRows)

Do
If Not InStr(1, ActiveCell.Value, "name") Then
If Not refrng.Find(ActiveCell.Value, lookat:=xlWhole) Is Nothing Then
Set f = refrng.Find(ActiveCell.Value, lookat:=xlWhole)
Range(f.Offset(0, 1), f.Offset(0, 2)).Copy ActiveCell.Offset(0, 1)
End If

ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""

ws1.Range("A1").Select

End Sub
'-------------------------------------------------

 

[Lillian]

Jay,

I think I am kind of confuse, here is what I would like
the excel spreed sheet is call test.xls

one sheet1 I have
Name type
aaa vvv
bbb xxx
ccc zzz

on sheet2 I have
Name IP SSN OS
aaa 10.1.1.1 xxxx xp
bbb 10.1.2.1 xxxx xp
ccc 10.1.3.1 xxxx xp
ddd 10.1.4.1 xxxx xp

now match sheet1 and sheet2 for name
if they are match will move IP, SSN, OS from sheet2 to sheet1 of ColumnC, D, E
if they are not match like sheet2 has ddd which is not on sheet1 then this
record of ddd need moved to sheet1

with all rows ddd,10.1.4.1, xxx, xp.

so the final sheet1 would look like this
Name type IP SSN OS
aaa vvv 10.1.1.1 xxxx xp
bbb xxx 10.1.2.1 xxxx xp
ccc zzz 10.1.3.1 xxxx xp
ddd 10.1.4.1 xxxx xp

thanks you so much for the help, I really appreciated it.

Lillian

 

[Jay]

Hi Lillian - Try this one...
--
Jay
---------------------------------------------------------------
Sub Lillian4()
'Looks up data for matched names, copies to sheet1
'Moves data from sheet2 to sheet1 for unmatched names
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim refrng As Range
Dim f As Range

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

Application.ScreenUpdating = False
'Take matching data from sheet2 and copy to sheet1
ws1.Activate
Range("A1").Select
Set refrng = ws2.Range("A1:A" & ws2.Rows.Count)
Do
If Not InStr(1, ActiveCell.Value, "name") Then
If Not refrng.Find(ActiveCell.Value, lookat:=xlWhole) Is Nothing Then
Set f = refrng.Find(ActiveCell.Value, lookat:=xlWhole)
Range(f.Offset(0, 1), f.Offset(0, 3)).Copy ActiveCell.Offset(0, 2)
End If
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""

'Take unmatched records from sheet2 and copy to sheet1
ws2.Activate
Range("A1").Activate
Set refrng = ws1.Range("A1:A" & ws1.Rows.Count)
Do
If Not InStr(1, ActiveCell.Value, "name") Then
If refrng.Find(ActiveCell.Value, lookat:=xlWhole) Is Nothing Then
Set a = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Offset(1, 0)
a.Value = ActiveCell.Value
a.Offset(0, 2) = ActiveCell.Offset(0, 1).Value
a.Offset(0, 3) = ActiveCell.Offset(0, 2).Value
a.Offset(0, 4) = ActiveCell.Offset(0, 3).Value
End If
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""

Application.ScreenUpdating = True
ws1.Activate
Range("A1").Select

End Sub