How to generate list of values from 2nd column that are not in 1st column?

A

AA Arens

I have two columns with values. How to generate a list of values from
the second column that are not in the first column?

I have tried with Vlook and Match but that failed.

Bart (excel 2003)
 
A

AA Arens

I have two columns with values. How to generate a list of values from
the second column that are not in the first column?

I have tried with Vlook and Match but that failed.

Bart (excel 2003)

I may have to use the Array function in order to create a new list.
 
J

James Ravenswood

I may have to use the Array function in order to create a new list.



Say we have values in columns A & B from A1 thru B20. In C1 enter:

=IF(COUNTIF($A$1:$A$20,B1)=0,B1,"") and copy down. Here is an
example:

24 2 2
14 7
38 30
30 12
6 3
14 14
23 15 15
21 32 32
20 34 34
26 12
3 3
41 28 28
46 12
24 33 33
36 30
7 44 44
21 41
12 42 42
13 27 27
50 42 42

Column C cotains those values from column B that are missing in column
A
 
G

GS

Here's a utility I worked on with Ron Rosenfeld and Jim Cone this past
week, which does what you want. You can choose the columns to compare
and where to put the non-matches. It will compare Col1 to Col2 for
matches and remove any it finds. It even has an option to remove
duplicate non-matches if your resulting list needs to be unique (no
dupes).

Paste the following code into a standard module in any workbook OR
PERSONAL.XLS if you want to have it always available but don't want the
target workbook to contain macros. To use it, just run the
CompareCols_StripDupes macro from the Macros dialog.


Sub CompareCols_StripDupes()
Dim bSuccess As Boolean, lMatchesFound As Long
Dim vAns As Variant, sMsg As String

sMsg = _
"Do you want to remove any duplicate items in the non-matches?" _
& vbLf & vbLf & "(Doing so will return a list of unique items)"
vAns = MsgBox(sMsg, vbYesNo + vbQuestion)

If vAns = vbNo Then
bSuccess = StripDupes(lMatchesFound) '//dupes allowed
Else
bSuccess = StripDupes(lMatchesFound, False) '//no dupes allowed
End If 'vAns = vbNo

If lMatchesFound = 0 Then MsgBox "No matches found!": Exit Sub
If lMatchesFound < 0 Then
sMsg = "Both columns must have more than 1 item!" _
& vbLf & vbLf _
& "Please try again: specify different columns!"
MsgBox sMsg, vbExclamation
Exit Sub
End If 'lMatchesFound < 0

If bSuccess Then
sMsg = Format(CStr(lMatchesFound), "#,##0") _
& " Matches were found"
If vAns = vbYes Then _
sMsg = sMsg & " (including non-match duplicates)"
MsgBox sMsg '//comment out if using option below

'Optional: Ask to run a process on the new list
' sMsg = sMsg & vbLf & vbLf _
' & "Do you want to process the new list?"
'
' vAns = MsgBox(sMsg, vbYesNo + vbQuestion)
' If vAns = vbYes Then
' 'Code... ('Call' a process to act on the new list)
' End If 'vAns = vbYes
Else
MsgBox "An error occured!"
End If 'bSuccess
End Sub

Function StripDupes(Matches As Long, _
Optional AllowDupes As Boolean = True) As Boolean
' Compares 2 user-specified cols and removes matches found.
' User can also specific target col to receive revised list.
'
' Args In: Matches: ByRef var to return number of matches found to
' the caller.
'
' AllowDupes: True by default. Keeps duplicate non-match
' values in col to remove dupes from. If passing False,
' duplicate items in non-match col are removed.
'
' Returns: True if matches found and no error occurs;
' False if a: matches not found --OR-- error occurs;
' b: either input col has less than 2 items.
'
' Sources: Ron Rosenfeld, Jim Cone, GS (Garry Sansom)

Dim i&, j&, lMatchesFound& 'as long
Dim vRngA, vRngB, vRngOut(), vAns 'as variant
Dim sRngOut As String

'Get the label of the columns to act on
Const sMsg As String = "Please enter the label of the column"
'Column to filter
vAns = Application.InputBox(sMsg _
& " to remove duplicates from", Type:=2)
If vAns = False Or vAns = "" Then Exit Function
vRngA = Range(vAns & "1:" & vAns _
& Cells(Rows.Count, vAns).End(xlUp).Row)
sRngOut = vAns '//output goes here unless specified below
'Column to be checked
vAns = Application.InputBox(sMsg _
& " to check for duplicates", Type:=2)
If vAns = False Or vAns = "" Then Exit Function
vRngB = Range(vAns & "1:" & vAns _
& Cells(Rows.Count, vAns).End(xlUp).Row)

'Make sure lists contain more than 1 item
If Not IsArray(vRngA) Or Not IsArray(vRngB) Then _
Matches = -1: Exit Function

'Column to receive the results
vAns = Application.InputBox(sMsg _
& "where the new list is to go" & vbLf _
& "(Leave blank or click 'Cancel' to use column " _
& UCase$(sRngOut) & ")", Type:=2)
If vAns = False Or vAns = "" Then sRngOut = sRngOut _
Else sRngOut = vAns

Debug.Print Now()
Dim cRngB As New Collection
On Error Resume Next
For j = LBound(vRngB) To UBound(vRngB)
cRngB.Add Key:=CStr(vRngB(j, 1)), Item:=vbNullString
Next 'j
Err.Clear: On Error GoTo ErrExit

If AllowDupes Then '//fastest
On Error GoTo MatchFound
For i = LBound(vRngA) To UBound(vRngA)
If cRngB.Key(CStr(vRngA(i, 1))) <> "" Then _
vRngA(i, 1) = "": lMatchesFound = lMatchesFound + 1
skipit:
Next 'i

Else '//slowest
On Error GoTo MatchFound
For i = LBound(vRngA) To UBound(vRngA)
cRngB.Add Key:=CStr(vRngA(i, 1)), Item:=vbNullString
Next 'i
End If 'AllowDupes
Err.Clear: On Error GoTo ErrExit

j = 0: ReDim vRngOut(UBound(vRngA) - lMatchesFound, 0)
For i = LBound(vRngA) To UBound(vRngA)
If Not vRngA(i, 1) = "" Then _
vRngOut(j, 0) = vRngA(i, 1): j = j + 1
Next 'i

If lMatchesFound > 0 Then '//only write if lMatchesFound > 0
Range(sRngOut & ":" & sRngOut).ClearContents
With Range(sRngOut & "1").Resize(UBound(vRngOut), 1)
.Value = vRngOut
.NumberFormat = "0000000000000" '//optional
.EntireColumn.AutoFit '//optional
End With
End If 'lMatchesFound > 0

Debug.Print Now()
ErrExit:
Matches = lMatchesFound: StripDupes = (Err = 0)
Exit Function

MatchFound:
If AllowDupes Then Resume skipit
vRngA(i, 1) = "": lMatchesFound = lMatchesFound + 1: Resume Next

End Function 'StripDupes()
 
A

AA Arens

Here's a utility I worked on with Ron Rosenfeld and Jim Cone this past
week, which does what you want. You can choose the columns to compare
and where to put the non-matches. It will compare Col1 to Col2 for
matches and remove any it finds. It even has an option to remove
duplicate non-matches if your resulting list needs to be unique (no
dupes).

Paste the following code into a standard module in any workbook OR
PERSONAL.XLS if you want to have it always available but don't want the
target workbook to contain macros. To use it, just run the
CompareCols_StripDupes macro from the Macros dialog.

Sub CompareCols_StripDupes()
  Dim bSuccess As Boolean, lMatchesFound As Long
  Dim vAns As Variant, sMsg As String

  sMsg = _
    "Do you want to remove any duplicate items in the non-matches?" _
    & vbLf & vbLf & "(Doing so will return a list of unique items)"
  vAns = MsgBox(sMsg, vbYesNo + vbQuestion)

  If vAns = vbNo Then
    bSuccess = StripDupes(lMatchesFound) '//dupes allowed
  Else
    bSuccess = StripDupes(lMatchesFound, False) '//no dupes allowed
  End If 'vAns = vbNo

  If lMatchesFound = 0 Then MsgBox "No matches found!": Exit Sub
  If lMatchesFound < 0 Then
    sMsg = "Both columns must have more than 1 item!" _
         & vbLf & vbLf _
         & "Please try again: specify different columns!"
    MsgBox sMsg, vbExclamation
    Exit Sub
  End If 'lMatchesFound < 0

  If bSuccess Then
    sMsg = Format(CStr(lMatchesFound), "#,##0") _
      & " Matches were found"
    If vAns = vbYes Then _
        sMsg = sMsg & " (including non-match duplicates)"
    MsgBox sMsg '//comment out if using option below

    'Optional: Ask to run a process on the new list
'    sMsg = sMsg & vbLf & vbLf _
'         & "Do you want to process the new list?"
'
'    vAns = MsgBox(sMsg, vbYesNo + vbQuestion)
'    If vAns = vbYes Then
'      'Code... ('Call' a process to act on the new list)
'    End If 'vAns = vbYes
  Else
    MsgBox "An error occured!"
  End If 'bSuccess
End Sub

Function StripDupes(Matches As Long, _
                    Optional AllowDupes As Boolean = True) As Boolean
' Compares 2 user-specified cols and removes matches found.
' User can also specific target col to receive revised list.
'
' Args In:    Matches: ByRef var to return number of matches found to
'             the caller.
'
'             AllowDupes: True by default.  Keeps duplicatenon-match
'             values in col to remove dupes from. If passing False,
'             duplicate items in non-match col are removed.
'
' Returns:    True if matches found and no error occurs;
'             False if  a: matches not found --OR-- error occurs;
'                       b: either input col has less than 2 items.
'
' Sources:    Ron Rosenfeld, Jim Cone, GS (Garry Sansom)

  Dim i&, j&, lMatchesFound& 'as long
  Dim vRngA, vRngB, vRngOut(), vAns 'as variant
  Dim sRngOut As String

  'Get the label of the columns to act on
  Const sMsg As String = "Please enter the label of the column"
  'Column to filter
  vAns = Application.InputBox(sMsg _
       & " to remove duplicates from", Type:=2)
  If vAns = False Or vAns = "" Then Exit Function
  vRngA = Range(vAns & "1:" & vAns _
        & Cells(Rows.Count, vAns).End(xlUp).Row)
  sRngOut = vAns '//output goes here unless specified below
  'Column to be checked
  vAns = Application.InputBox(sMsg _
       & " to check for duplicates", Type:=2)
  If vAns = False Or vAns = "" Then Exit Function
  vRngB = Range(vAns & "1:" & vAns _
        & Cells(Rows.Count, vAns).End(xlUp).Row)

  'Make sure lists contain more than 1 item
  If Not IsArray(vRngA) Or Not IsArray(vRngB) Then _
    Matches = -1: Exit Function

  'Column to receive the results
  vAns = Application.InputBox(sMsg _
       & "where the new list is to go" & vbLf _
       & "(Leave blank or click 'Cancel' to use column " _
       & UCase$(sRngOut) & ")", Type:=2)
  If vAns = False Or vAns = "" Then sRngOut = sRngOut _
                           Else sRngOut = vAns

Debug.Print Now()
  Dim cRngB As New Collection
  On Error Resume Next
  For j = LBound(vRngB) To UBound(vRngB)
    cRngB.Add Key:=CStr(vRngB(j, 1)), Item:=vbNullString
  Next 'j
  Err.Clear: On Error GoTo ErrExit

  If AllowDupes Then '//fastest
    On Error GoTo MatchFound
    For i = LBound(vRngA) To UBound(vRngA)
      If cRngB.Key(CStr(vRngA(i, 1))) <> "" Then _
        vRngA(i, 1) = "": lMatchesFound = lMatchesFound + 1
skipit:
    Next 'i

  Else '//slowest
    On Error GoTo MatchFound
    For i = LBound(vRngA) To UBound(vRngA)
      cRngB.Add Key:=CStr(vRngA(i, 1)), Item:=vbNullString
    Next 'i
  End If 'AllowDupes
  Err.Clear: On Error GoTo ErrExit

  j = 0: ReDim vRngOut(UBound(vRngA) - lMatchesFound, 0)
  For i = LBound(vRngA) To UBound(vRngA)
    If Not vRngA(i, 1) = "" Then _
      vRngOut(j, 0) = vRngA(i, 1): j = j + 1
  Next 'i

  If lMatchesFound > 0 Then '//only write if lMatchesFound > 0
    Range(sRngOut & ":" & sRngOut).ClearContents
    With Range(sRngOut & "1").Resize(UBound(vRngOut), 1)
      .Value = vRngOut
      .NumberFormat = "0000000000000" '//optional
      .EntireColumn.AutoFit '//optional
    End With
  End If 'lMatchesFound > 0

Debug.Print Now()
ErrExit:
  Matches = lMatchesFound: StripDupes = (Err = 0)
  Exit Function

MatchFound:
  If AllowDupes Then Resume skipit
  vRngA(i, 1) = "": lMatchesFound = lMatchesFound + 1: Resume Next

End Function 'StripDupes()

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thank you for the input. Using the solution from James, how to have
the values automatically on the top, other then using the A-Z order
button.
 
A

AA Arens

Thank you for the input. Using the solution from James, how to have
the values automatically on the top, other then using the A-Z order
button.

Thank you for the input. Using the solution from James, how to have
the values automatically on the top, other then using the A-Z order
button.
How to bypass a result "0" if either of the columns is longer?
 
G

GS

Thank you for the input. Using the solution from James, how to have
the values automatically on the top, other then using the A-Z order
button.
How to bypass a result "0" if either of the columns is longer?

James' formula should return an empty string if there are matches, OR
the value in B if no match.
--

My code returns a list of unique values in the same order as listed in
ColB, but with all values found in ColA removed. You can put the new
list of non-matches in any column you want. To do this for your
scenario, enter the following when prompted...

1st prompt: type "b" (without the quotes)
2nd prompt: type "a" (without the quotes)
3rd prompt: type "c" (without the quotes)

The macro will compare ColB to ColA and remove any matches from ColB's
data (not in the spreadsheet) to return a new list (minus the matches)
in whatever col you typed for the 3rd prompt. When done, your original
data remains plus a new col with the non-matched data. If any of the
non-matched data is duplicated but dupes are not wanted, you can answer
'Yes' the the first question that appears just before the prompts for
col labels.
 
J

James Ravenswood

James Ravenswood brought next idea :



The code I posted also removes blanks so the resulting list is
contiguous starting in Rows(1) of whatever column is chosen for the
results.

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



I tried you code and it works very well.
I like the approach because it is direct. Using your UDFs, we don't
have to make a column with blanks and then make another column with
the blanks removed.
Nice work.
 
G

GS

James Ravenswood formulated on Monday :
I tried you code and it works very well.
I like the approach because it is direct. Using your UDFs, we don't
have to make a column with blanks and then make another column with
the blanks removed.
Nice work.

Thanks, James. Ron, Jim, and I appreciate your comments. I'm not in
agreement, however, that the function qualifies as a 'UDF' (such as one
might think could be called from a worksheet cell) since it modifies
cells.<g> I'm sure that's not what you meant and so I just point this
out for clarity.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top