Unable to populate unique values in third sheet comparing the values of the second sheet to the first one - excel

Question

I've got three sheets - main,specimen and output in an excel workbook. The sheet main and speciment contain some information. Some of the information in two sheets are identical but few of them are not. My intention is to paste those information in output which are available in speciment but not in main.
I've tried like [currently it fills in lots of cells producing duplicates]:
Sub getData()
Dim cel As Range, celOne As Range, celTwo As Range
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("main")
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("specimen")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("output")
For Each cel In ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).row)
For Each celOne In ws1.Range("A2:A" & ws1.Cells(Rows.Count, 1).End(xlUp).row)
If cel(1, 1) <> celOne(1, 1) Then ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).value = celOne(1, 1)
Next celOne
Next cel
End Sub
main contains:
UNIQUE ID FIRST NAME LAST NAME
A0000477 RICHARD NOEL AARONS
A0001032 DON WILLIAM ABBOTT
A0290191 REINHARDT WESTER CARLSON
A0290284 RICHARD WARREN CARLSON
A0002029 RAYMOND MAX ABEL
A0002864 DARRYL SCOTT ABLING
A0003916 GEORGES YOUSSEF ACCAOUI
specimen contains:
UNIQUE ID FIRST NAME LAST NAME
A0288761 ROBERT HOWARD CARLISLE
A0290284 RICHARD WARREN CARLSON
A0290688 THOMAS A CARLSTROM
A0002029 RAYMOND MAX ABEL
A0002864 DARRYL SCOTT ABLING
output should contain [EXPECTED]:
UNIQUE ID FIRST NAME LAST NAME
A0288761 ROBERT HOWARD CARLISLE
A0290688 THOMAS A CARLSTROM
How can I achieve that?

Answer 1

If you have the latest version of Excel, with the FILTER function and dynamic arrays, you can do this with an Excel formula.
I changed your Main and Specimen data into tables.
On the Output worksheet you can then enter this formula into a single cell:
=FILTER(specTbl,ISNA(MATCH(specTbl[UNIQUE ID],mnTbl[UNIQUE ID],0)))
The remaining fields will autopopulate with the results.
For a VBA solution, I like to use Dictionaries, and VBA arrays for speed.
'set reference to microsoft scripting runtime
' or use late-binding
Option Explicit
Sub findMissing()
Dim wsMain As Worksheet, wsSpec As Worksheet, wsOut As Worksheet
Dim dN As Dictionary, dM As Dictionary
Dim vMain As Variant, vSpec As Variant, vOut As Variant
Dim I As Long, v As Variant
With ThisWorkbook
Set wsMain = .Worksheets("Main")
Set wsSpec = .Worksheets("Specimen")
Set wsOut = .Worksheets("Output")
End With
'Read data into vba arrays for processing speed
With wsMain
vMain = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
End With
With wsSpec
vSpec = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
End With
'add ID to names dictionary
Set dN = New Dictionary
For I = 2 To UBound(vMain, 1)
dN.Add Key:=vMain(I, 1), Item:=I
Next I
'add missing ID's to missing dictionary
Set dM = New Dictionary
For I = 2 To UBound(vSpec, 1)
If Not dN.Exists(vSpec(I, 1)) Then
dM.Add Key:=vSpec(I, 1), Item:=WorksheetFunction.Index(vSpec, I, 0)
End If
Next I
'write results to output array
ReDim vOut(0 To dM.Count, 1 To 3)
vOut(0, 1) = "UNIQUE ID"
vOut(0, 2) = "FIRST NAME"
vOut(0, 3) = "LAST NAME"
I = 0
For Each v In dM.Keys
I = I + 1
vOut(I, 1) = dM(v)(1)
vOut(I, 2) = dM(v)(2)
vOut(I, 3) = dM(v)(3)
Next v
Dim R As Range
With wsOut
Set R = .Cells(1, 1)
Set R = R.Resize(UBound(vOut, 1) + 1, UBound(vOut, 2))
With R
.EntireColumn.Clear
.Value = vOut
.Style = "Output"
.EntireColumn.AutoFit
End With
End With
End Sub
Both show the same result (except the formula solution does not bring over the column headers; but you can do that with a formula =mnTbl[#Headers] in the cell above the original formula above).

Answer 2

Another option is to join the values of each row in each range and store them in arrays.
Then compare arrays and output the unique values.
In this case, your uniques come from evaluating the whole row, and not just the Unique ID.
Please read code's comments and adjust it to fit your needs.
Public Sub OutputUniqueValues()
Dim mainSheet As Worksheet
Dim specimenSheet As Worksheet
Dim outputSheet As Worksheet
Dim mainRange As Range
Dim specimenRange As Range
Dim mainArray As Variant
Dim specimenArray As Variant
Dim mainFirstRow As Long
Dim specimenFirstRow As Long
Dim outputCounter As Long
Set mainSheet = ThisWorkbook.Worksheets("main")
Set specimenSheet = ThisWorkbook.Worksheets("specimen")
Set outputSheet = ThisWorkbook.Worksheets("output")
' Row at which the output range will be printed (not including headers)
outputCounter = 2
' Process main data ------------------------------------
' Row at which the range to be evaluated begins
mainFirstRow = 2
' Turn range rows into array items
mainArray = ProcessRangeData(mainSheet, mainFirstRow)
' Process specimen data ------------------------------------
' Row at which the range to be evaluated begins
specimenFirstRow = 2
' Turn range rows into array items
specimenArray = ProcessRangeData(specimenSheet, specimenFirstRow)
' Look for unique values and output results in sheet
OutputUniquesFromArrays outputSheet, outputCounter, mainArray, specimenArray
End Sub
Private Function ProcessRangeData(ByVal dataSheet As Worksheet, ByVal firstRow As Long) As Variant
Dim dataRange As Range
Dim evalRowRange As Range
Dim lastRow As Long
Dim counter As Long
Dim dataArray As Variant
' Get last row in sheet (column 1 = column A)
lastRow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
' Set the range of specimen sheet
Set dataRange = dataSheet.Range("A" & firstRow & ":C" & lastRow)
' Redimension the array to the number of rows in range
ReDim dataArray(dataRange.Rows.Count)
counter = 0
' Join each row values so it's easier to compare them later and add them to an array
For Each evalRowRange In dataRange.Rows
' Use Trim function if you want to omit the first and last characters if they are spaces
dataArray(counter) = Trim(evalRowRange.Cells(1).Value) & "|" & Trim(evalRowRange.Cells(2).Value) & "|" & Trim(evalRowRange.Cells(3).Value)
counter = counter + 1
Next evalRowRange
ProcessRangeData = dataArray
End Function
Private Sub OutputUniquesFromArrays(ByVal outputSheet As Worksheet, ByVal outputCounter As Long, ByVal mainArray As Variant, ByVal specimenArray As Variant)
Dim specimenFound As Boolean
Dim specimenCounter As Long
Dim mainCounter As Long
' Look for unique values ------------------------------------
For specimenCounter = 0 To UBound(specimenArray)
specimenFound = False
' Check if value in specimen array exists in main array
For mainCounter = 0 To UBound(mainArray)
If specimenArray(specimenCounter) = mainArray(mainCounter) Then specimenFound = True
Next mainCounter
If specimenFound = False Then
' Write values to output sheet
outputSheet.Range("A" & outputCounter).Value = Split(specimenArray(specimenCounter), "|")(0)
outputSheet.Range("B" & outputCounter).Value = Split(specimenArray(specimenCounter), "|")(1)
outputSheet.Range("C" & outputCounter).Value = Split(specimenArray(specimenCounter), "|")(2)
outputCounter = outputCounter + 1
End If
Next specimenCounter
End Sub