![]() |
Finding Unique Entries Among Two Columns
Hello Bob,
I've just seen that Jim has responded with using a dictionary which will probably perform better than the code below..........but there you go I've written it now! :) Best regards John Sub FindUniqueProjects() On Error GoTo errHandler Dim iRowNewProjects As Integer Dim iRow As Integer Dim iCol As Integer Dim wks As Worksheet Dim colExistingB As New Collection Dim sTempProjectNumber As String Dim bFoundDuplicate As Boolean Set wks = Application.ActiveSheet iCol = 2 iRow = 2 'Fill collection with check values Do Until wks.Cells(iRow, iCol).Value = "" colExistingB.Add wks.Cells(iRow, iCol).Value, CStr(wks.Cells(iRow, iCol).Value) iRow = iRow + 1 Loop 'Now run down the column to be checked ('A') iCol = 1 iRow = 2 iRowNewProjects = iRow Do Until wks.Cells(iRow, iCol).Value = "" sTempProjectNumber = wks.Cells(iRow, iCol).Value For i = 1 To colExistingB.Count If sTempProjectNumber = colExistingB(i) Then bFoundDuplicate = True Exit For End If Next i If bFoundDuplicate = False Then wks.Cells(iRowNewProjects, iCol + 2).Value = sTempProjectNumber iRowNewProjects = iRowNewProjects + 1 End If bFoundDuplicate = False iRow = iRow + 1 Loop exitHe Exit Sub errHandler: If Err.Number = 457 Then 'Already in collection Resume Next Else MsgBox Err.Description & " (" & Err.Number & ")", vbExclamation Resume exitHere End If End Sub "Bob" wrote in message ... Columns A & B contain several thousand Project Numbers (e.g., P1052, PA844, P6721.6, etc.). Column A has the latest list of Project Numbers. Column B has an older list of Project Numbers. As such, column B is a subset of column A. I need to find all of the "new" (i.e., unique) Project Numbers that exist in column A relative to column B, and put the results in column C. Please note that row 1 is used for column headings, so the data contained in columns A and B start in row 2. I would appreciate any help in writing a macro that compares the Project Numbers in columns A and B and outputs the unique Project Numbers to column C (starting in row 2). The macro would know to stop when it encounters the last Project Number in column A (FYI - there are blank cells after the last Project Number in column A, which obviously is the longest of the two columns). Thanks for the help. Bob |
Finding Unique Entries Among Two Columns
John,
Thanks for taking the time to put together the solution below. I sincerely appreciate it. Just out of curiosity, I'm going to try your code as well. Thanks again for all your help. Regards, Bob "John" wrote: Hello Bob, I've just seen that Jim has responded with using a dictionary which will probably perform better than the code below..........but there you go I've written it now! :) Best regards John Sub FindUniqueProjects() On Error GoTo errHandler Dim iRowNewProjects As Integer Dim iRow As Integer Dim iCol As Integer Dim wks As Worksheet Dim colExistingB As New Collection Dim sTempProjectNumber As String Dim bFoundDuplicate As Boolean Set wks = Application.ActiveSheet iCol = 2 iRow = 2 'Fill collection with check values Do Until wks.Cells(iRow, iCol).Value = "" colExistingB.Add wks.Cells(iRow, iCol).Value, CStr(wks.Cells(iRow, iCol).Value) iRow = iRow + 1 Loop 'Now run down the column to be checked ('A') iCol = 1 iRow = 2 iRowNewProjects = iRow Do Until wks.Cells(iRow, iCol).Value = "" sTempProjectNumber = wks.Cells(iRow, iCol).Value For i = 1 To colExistingB.Count If sTempProjectNumber = colExistingB(i) Then bFoundDuplicate = True Exit For End If Next i If bFoundDuplicate = False Then wks.Cells(iRowNewProjects, iCol + 2).Value = sTempProjectNumber iRowNewProjects = iRowNewProjects + 1 End If bFoundDuplicate = False iRow = iRow + 1 Loop exitHe Exit Sub errHandler: If Err.Number = 457 Then 'Already in collection Resume Next Else MsgBox Err.Description & " (" & Err.Number & ")", vbExclamation Resume exitHere End If End Sub "Bob" wrote in message ... Columns A & B contain several thousand Project Numbers (e.g., P1052, PA844, P6721.6, etc.). Column A has the latest list of Project Numbers. Column B has an older list of Project Numbers. As such, column B is a subset of column A. I need to find all of the "new" (i.e., unique) Project Numbers that exist in column A relative to column B, and put the results in column C. Please note that row 1 is used for column headings, so the data contained in columns A and B start in row 2. I would appreciate any help in writing a macro that compares the Project Numbers in columns A and B and outputs the unique Project Numbers to column C (starting in row 2). The macro would know to stop when it encounters the last Project Number in column A (FYI - there are blank cells after the last Project Number in column A, which obviously is the longest of the two columns). Thanks for the help. Bob |
All times are GMT +1. The time now is 05:38 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com