Additional Code for Mr. Pearsons MergeDistinct Code

[VickiMc]

I have adapted Mr. Pearsons MergeDistinct code for "Merging Lists to a List
of Distinct Values", if anyone is familiar with it.
What I would like the code to do first though is check that ColA contains
the one digit Code "A" then continue with evaluating ColB for unique values
to copy to the new list.
EG: in the table below, only rows 2, 3, & 4 would be assessed because ColA
contains an 'A", and then only Rows 2 & 3 would be copied to the new list
because they contain unique data in ColB.

1: B | Four
2: A | Five
3: A | Three
4: A | Five
5: C | One

Thank You (in anticipatiion)
Fond Regards
vicki

 

[VickiMc]

Thanks Joel,
One question though, do I use this instead of, or in conjunction with the
MergeDistinct Code?

This is the code I have adapted to merge the two lists into one (I probably
should have placed this in the initial posting, sorry!).

My modifications included changing the ColumnToMatch, to ColumnToMatch1 &
ColumnToMatch2, as both columns are side by side (K and L) on the one
spreadsheet (as opposed to Column C on Sheets 1 & 2 as Mr. Pearson originally
designed the code to do).

Column E is the column on my spreadsheet I need the code to analyis before
it transfers the data from ColL, and then ColK to the (1column) list. NB: The
data in ColE is not transferred.



Sub MergeDistinct()
'MergeDistinct
'This procedure merges two lists into a separate list that contains no
duplicate values.

Dim R As Range 'Range loop variable
Dim LastCell As Range 'Last Cell in input columns
Dim WS As Worksheet 'Worksheet Reference
Dim N As Long 'Result of Duplicates test.
Dim M As Long 'Rows in merged list
Dim StartList1 As Range 'First Cell of first list to merge
Dim StartList2 As Range 'First Cell of second list to merge
Dim StartOutputList As Range 'First Cell of merged list
Dim ColumnToMatch1 As Variant 'Column in input lists to test for duplicates
Dim ColumnToMatch2 As Variant 'Column in input lists to test for duplicates
Dim ColumnsToCopy As Long 'Number of Columns in each input list to
copy to output.

'This is the column in the input lists that is to be tested for duplicates
ColumnToMatch1 = "L"
ColumnToMatch2 = "K"

'This is the number of columns from each list to be merged that are copied
to the result list.
ColumnsToCopy = 1

'The output list begins in this cell.
Set StartOutputList = Worksheets("Dwg_TakeOffs").Range("A2")

'The first list to be merged starts here
Set StartList1 = Worksheets("database").Range("L5")
Set WS = StartList1.Worksheet
With WS
M = 1
'get the last used cell in the first list to be merged
Set LastCell = .Cells(.Rows.Count, StartList1.Column).End(xlUp)
'loop though the range of values
For Each R In .Range(StartList1, LastCell)
If R.Value <> vbNullString Then
N = Application.CountIf(StartOutputList.Resize(M, 1), _
R.EntireRow.Cells(1, ColumnToMatch1).Text)
'if N = 0, then the item is not in the merged result
'list, so copy the data over. If N > 0, we've already
'encountered the value, so do nothing
If N = 0 Then
StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
R.Resize(1, ColumnsToCopy).Value
'M is the number of rows in the merged list. Increment it.
M = M + 1
End If
End If
Next R
End With

'The second list to be merged starts here.
Set StartList2 = Worksheets("Database").Range("K5")
Set WS = StartList2.Worksheet
With WS
Set LastCell = .Cells(.Rows.Count, StartList2.Column).End(xlUp)
For Each R In .Range(StartList2, LastCell)
If R.Value <> vbNullString Then
N = Application.CountIf(StartOutputList.Resize(M, 1), _
R.EntireRow.Cells(1, ColumnToMatch2).Text)
If N = 0 Then
StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
R.Resize(1, ColumnsToCopy).Value
M = M + 1
End If
End If
Next R
End With

End Sub

 

[VickiMc]

Thanks Joel, you've been most helpful and you're right it does work well.

The only difference is that Mr. Pearsons code copies only the one cell of
data contained in Column K or Column L (but not in both) and produces a
1column vector (List) on the destination sheet. (Yours copies the entire row.)

In laymens terms were you to do it the long way - one would use the
following steps

1) concatenate Columns E & K into Cell A1 on new a Worksheet. Then,
2) concatenate Columns E & L into Cell B1 on new a Worksheet. Then,
3) Cut-PasteSpecial-Values, both columns A & B, in-situ. Then,
4) Cut the data from Column B and append it below the data in Column A. Then,
5) Sort column A. Then,
6) Delete all the rows from the column that don't commence with 'A'. Then,
7) Put a formula in Column B that trimmed the first letter from the data in
Column A. Then,
8) Cut-PasteSpecial-Values, column B, insitu. Then,
9) Delete Entire Column A, such that Column B now becomes Column A. Then,
10) Sort Column A. And finally,
11) Manually going down the list, delete each row that contains duplicated
data - which gives you a list of unique values that appears either in column
K or Column L (but not both) of the original spreadsheet.
(NB: one could also write a MAX() to find the unique values, but I'm
guessing it is painfully obvious now what I'm trying to achieve - I think.)