This is the sample dataset I created. The OP's code suggests that the Active Directory tab has an extra row.
Always Use Worksheets CodeNames Whenever Possible
Referencing worksheets by their code names will avoid naming conflicts while working with multiple workbooks and changing the worksheet name will not break any code.
- Sheets("Active Directory") -> wsActiveDirectory
- Sheets("Dump")-> wsDump
- Sheets("Output") -> wsOutput
Use Constants for Magic Numbers
Using constants for values that should only be set once will make your code easier to read and maintain. Constants will also throw an error if you try to change their values.
Before
startRow = 5
outputRow = 5
After
Const startRow As Long = 5, outputRow As Long = 5
Matching Lists
Dictionaries are optimised for fast lookups. Using a Scripting.Dictionary will match the values will easily make the code run 100 times faster.
The trick is to create a composite key for all fields. Note: make sure to use a delimiter.
1;Towney;Research and Development
Private Function getKey(ByVal rowIndex As Long, ByRef Target As Range) As String
getKey = Target.Cells(rowIndex, 1) & ";" & Target.Cells(rowIndex, 2) & ";" & Target.Cells(rowIndex, 3)
End Function
SQL Solution
As Ryan Wildry stated "Using SQL is great for these type of set based comparisons." but this can be a little tricky. The way I did it is I pasted my datasets into an Access Database as tables and use the Query Designer to help me write the code.
SELECT Dump.ID, Dump.Name, Dump.Department, "Item found in ""Dump"" but not in ""Active Directory""" AS [Found]
FROM Dump
WHERE (((Exists (SELECT NULL
FROM [Active Directory]
WHERE ([Active Directory].ID = Dump.ID) AND ([Active Directory].Name = Dump.Name) AND ([Active Directory].Department = Dump.Department)
))=False));
UNION ALL SELECT [Active Directory].ID, [Active Directory].Name, [Active Directory].Department, "Item found in ""Active Directory"" but not in ""[Active Directory]""" AS [Found]
FROM [Active Directory]
WHERE (((Exists (SELECT NULL
FROM [Dump]
WHERE ([Active Directory].ID = Dump.ID) AND ([Active Directory].Name = Dump.Name) AND ([Active Directory].Department = Dump.Department)
))=False));
I then aliased the tables to make it easier to replace the table names with the Excel Table Definition.
SELECT t1.Name, t1.ID, t1.Department, 'Item found in "Dump" but not in "Active Directory"' AS [Found]
FROM [Dump$B4:E23] As t1
WHERE (((Exists (SELECT NULL
FROM [Active Directory] As t2
WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)
))=False))
UNION ALL
SELECT t1.Name, t1.ID, t1.Department, 'Item found in "Active Directory" but not in "Dump"' AS [Found]
FROM [Active Directory$B4:E20] As t1
WHERE (((Exists (SELECT NULL
FROM [Dump] As t2
WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)
))=False))
Now that I had the SQL working, I replaced the messages and created a single Select statement that I could modify to handle both selecting record in Dump and not in Active Directory or selecting records in Active Directory that are not in Dump.
SELECT t1.ID, t1.Name, t1.Department, "Message" AS [Found]
FROM [Dump] As t1
WHERE (((Exists (SELECT NULL
FROM [Active Directory] As t2
WHERE (t2.ID = t1.ID) AND (t2.Name = t1.Name) AND (t2.Department = t1.Department)
))=False));
Sub FindUnmatchedRowsCopyFromRecordset()
Create a recordset and use Range.CopyFromRecordset to transfer the records.
Sample SQl:
SELECT t1.Name, t1.ID, t1.Department, 'Item found in "Dump" but not in "Active Directory"' AS [Found]
FROM [Dump$B4:E23] As t1
WHERE (((Exists (SELECT NULL
FROM [Active Directory$B4:E20] As t2
WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)
))=False))
UNION ALL
SELECT t1.Name, t1.ID, t1.Department, 'Item found in "Active Directory" but not in "Dump"' AS [Found]
FROM [Active Directory$B4:E20] As t1
WHERE (((Exists (SELECT NULL
FROM [Dump$B4:E23] As t2
WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)
))=False))
Sub FindUnmatchedRowsAppend()
This is a slightly more complicated technique that appends the records directly to the Output tab.
Sample SQl:
INSERT INTO [Output$B4:E4] SELECT t3.* FROM (SELECT t1.Name, t1.ID, t1.Department, 'Item found in "Dump" but not in "Active Directory"' AS [Found]
FROM [Dump$B4:E23] As t1
WHERE (((Exists (SELECT NULL
FROM [Active Directory$B4:E20] As t2
WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)
))=False))
UNION ALL
SELECT t1.Name, t1.ID, t1.Department, 'Item found in "Active Directory" but not in "Dump"' AS [Found]
FROM [Active Directory$B4:E20] As t1
WHERE (((Exists (SELECT NULL
FROM [Dump$B4:E23] As t2
WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)
))=False))) as t3
Code
Option Explicit
Sub FindUnmatchedRowsAppend()
Dim conn As Object
Set conn = getThisWorkbookConnection
conn.Open
DeleteOutputResults
Dim OutputDef As String
OutputDef = getTableDefinition(wsOutput)
Dim SQL As String
SQL = "INSERT INTO " & OutputDef & " SELECT t3.* FROM (" & getOutputResultQuery & ") as t3"
conn.Execute SQL
conn.Close
End Sub
Public Sub FindUnmatchedRowsCopyFromRecordset()
Dim conn As Object
Set conn = getThisWorkbookConnection
conn.Open
Dim SQL As String
SQL = getOutputResultQuery
Dim rs As Object
Set rs = conn.Execute(SQL)
DeleteOutputResults
wsOutput.Range("B5").CopyFromRecordset rs
conn.Close
End Sub
Private Function getOutputResultQuery() As String
Dim ActiveDirectoryDef As String
ActiveDirectoryDef = getTableDefinition(wsActiveDirectory)
Dim DumpDef As String
DumpDef = getTableDefinition(wsDump)
Const BaseSQl As String = "SELECT t1.Name, t1.ID, t1.Department, '@Message' AS [Found]" & vbNewLine & _
"FROM [xlTable1] As t1" & vbNewLine & _
"WHERE (((Exists (SELECT NULL" & vbNewLine & _
" FROM [xlTable2] As t2" & vbNewLine & _
" WHERE (t2.ID = t1.ID) And (t2.Name = t1.Name) And (t2.Department = t1.Department)" & vbNewLine & _
"))=False))"
Dim SelectDump As String
SelectDump = Replace(BaseSQl, "[xlTable1]", DumpDef)
SelectDump = Replace(SelectDump, "[xlTable2]", ActiveDirectoryDef)
SelectDump = Replace(SelectDump, "@Message", "Item found in ""Dump"" but not in ""Active Directory""")
Dim SelectAD As String
SelectAD = Replace(BaseSQl, "[xlTable1]", ActiveDirectoryDef)
SelectAD = Replace(SelectAD, "[xlTable2]", DumpDef)
SelectAD = Replace(SelectAD, "@Message", "Item found in ""Active Directory"" but not in ""Dump""")
Dim SQL As String
SQL = SelectDump & vbNewLine & "UNION ALL" & vbNewLine & SelectAD
getOutputResultQuery = SQL
End Function
Private Sub DeleteOutputResults()
Dim Target As Range
With wsOutput
Set Target = .Range("B4:E4", .Cells(.Rows.Count, "B").End(xlUp))
Target.Offset(1).ClearContents
End With
End Sub
Private Function getTableDefinition(ws As Worksheet) As String
Dim Target As Range
Select Case ws.Name
Case wsActiveDirectory.Name, wsDump.Name
With ws
Set Target = .Range("B4:E4", .Cells(.Rows.Count, "B").End(xlUp))
End With
If ws Is wsActiveDirectory Then
Rem Remove Summary Row
Set Target = Target.Resize(Target.Rows.Count - 1)
End If
Case wsOutput.Name
With ws
Set Target = .Range("B4:E4", .Cells(.Rows.Count, "B").End(xlUp))
End With
End Select
getTableDefinition = getTableDefinitionFromRange(Target)
End Function
Private Function getThisWorkbookConnection() As Object
Dim conn As Object
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
End With
Set getThisWorkbookConnection = conn
End Function
Private Function getTableDefinitionFromRange(Target As Range) As String
Dim SheetName As String
SheetName = Target.Parent.Name
Dim Address As String
Address = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
getTableDefinitionFromRange = "[" & SheetName & "$" & Address & "]"
End Function
Download Link
ADDump.xlsm
Option Explicit, declaring variables on one line (hint:Dim dumpSheet, referencesheet, outputSheet As Worksheetdoes not do what you think it does), explicitly using default actions (e.g.Range(x).Value=""instead ofRange(x) = "") and declaring variables near where you use them. \$\endgroup\$SQLis great for these type of set based comparisons. You can use ADO in Excel if you wish, although it plays nicer in an actual database. I'd recommend checking that out though! \$\endgroup\$