ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Finding Unique Entries Among Two Columns (https://www.excelbanter.com/excel-programming/364982-re-finding-unique-entries-among-two-columns.html)

John[_88_]

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




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