View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Jay Jay is offline
external usenet poster
 
Posts: 671
Default Excel Macro for match name

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" wrote:

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" wrote:

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
--
Jay


"Lillian" wrote:

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