Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to search, compare, copy and delete
Hi everyone,
I am trying to figure out a way to easily do this task. I have an Excel file containing a list of people. This list is i "Sheet1" The headers for each column in this list a Column A Dept. Name Column B Last Name Column C First Name Column D Email Address Column E Newtork ID I have another list in "Sheet2" The headers for each column in this list a Column A Name The names in this column are formatted as "First name space Last Name" for instance, "John Doe" . What I want to do is compare the names in Column A on "Sheet2" wit Column B and Column C in "Sheet1" If they are the same name, then copy Column A, D and E into "Sheet2 and remove the row containing matching the name in "Sheet1" Thanks in advance for any help. Mar -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to search, compare, copy and delete
Suggested is the following:
Sub TransferAndDelete() Dim Rng1 As Range, Rng2 As Range, Rng3 As Range Dim C1 As Range, C2 As Range, C3 As Range Dim FNm As String, LNm As String With Sheets("Sheet2") Set Rng1 = .Range("A2:A" & .UsedRange.Rows.Count) 'Next line only necessary if gap in data possible Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants) End With With Sheets("Sheet1") Set Rng2 = .Range("B2:B" & .UsedRange.Rows.Count) 'Next line only necessary if gap in data possible Set Rng2 = Rng2.SpecialCells(xlCellTypeConstants) Set Rng3 = Rng2.Offset(, 1) End With For Each C1 In Rng1.Cells C1 = Trim(C1) If InStr(2, C1, " ") 0 Then FNm = Left(C1, InStr(1, C1, " ") - 1) LNm = Right(C1, Len(C1) - Len(FNm) - 1) Else FNm = "" LNm = "" End If For Each C2 In Rng2.Cells C2 = Trim(C2) If C2 = LNm Then Set C3 = C2(1, 2) If Trim(C3) = FNm Then C1(1, 2) = C2(1, 0) C1(1, 3) = C3(1, 2) C1(1, 4) = C3(1, 3) C2.EntireRow.EntireRow.Delete End If End If Next Next End Sub Minimal testing done. Regards, Greg (VBA Amateur) |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to search, compare, copy and delete
Correction to the line:
C2.EntireRow.EntireRow.Delete Should be C2.EntireRow.Delete Don't know how that happened ??? Regards, Greg -----Original Message----- Suggested is the following: Sub TransferAndDelete() Dim Rng1 As Range, Rng2 As Range, Rng3 As Range Dim C1 As Range, C2 As Range, C3 As Range Dim FNm As String, LNm As String With Sheets("Sheet2") Set Rng1 = .Range("A2:A" & .UsedRange.Rows.Count) 'Next line only necessary if gap in data possible Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants) End With With Sheets("Sheet1") Set Rng2 = .Range("B2:B" & .UsedRange.Rows.Count) 'Next line only necessary if gap in data possible Set Rng2 = Rng2.SpecialCells(xlCellTypeConstants) Set Rng3 = Rng2.Offset(, 1) End With For Each C1 In Rng1.Cells C1 = Trim(C1) If InStr(2, C1, " ") 0 Then FNm = Left(C1, InStr(1, C1, " ") - 1) LNm = Right(C1, Len(C1) - Len(FNm) - 1) Else FNm = "" LNm = "" End If For Each C2 In Rng2.Cells C2 = Trim(C2) If C2 = LNm Then Set C3 = C2(1, 2) If Trim(C3) = FNm Then C1(1, 2) = C2(1, 0) C1(1, 3) = C3(1, 2) C1(1, 4) = C3(1, 3) C2.EntireRow.EntireRow.Delete End If End If Next Next End Sub Minimal testing done. Regards, Greg (VBA Amateur) . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Search / Compare / Copy Value Up (cpm) | Excel Discussion (Misc queries) | |||
Macro to Search and Copy | Excel Discussion (Misc queries) | |||
Search, Copy, Paste Macro in Excel | Excel Worksheet Functions | |||
search/copy/paste macro | Excel Programming | |||
Search/copy/paste Macro | Excel Programming |