I'll add an entirely in-memory way to achieve the output.
The one thing worth considering is that we have no way of differentiating one ID from the next if they have matching stock, price, qty, and dates. So, the way I'm handling duplicates is in the order that they appear in the spreadsheet. So if there are two matching entries in your table, and only 1 in the broker table, I assume that the first entry in your table matches the first entry in the broker table, and therefore your second entry will be output.
Try working through the code. I took a few shortcuts for the sake of timing, but I also encapsulated each of the functions so that you can modify as needed. You'll just have to build out the DeserializeKey function to convert a key back to cells in the output sheet (shouldn't be too hard). See the below code, and let me know if it meets expectations.
Note: You will run the "CompareDictionaries" subroutine. The others are helper functions.
Sub CompareDictionaries()
Dim oMine As Object
Dim oBroker As Object
Dim myQueueCount As Long
Dim brokerQueueCount As Long
Dim minQueue As Long
Dim oMinQueue As Object
Set oMine = GetDictionary(Sheet1.Range("A2:E7"))
Set oBroker = GetDictionary(Sheet2.Range("A2:E6"))
For Each oKey In oMine.keys
'The whole row does not exist in the broker table
If Not oBroker.Exists(oKey) Then
Do While oMine(oKey).Count > 0
DeserializeKey oKey, oMine(oKey).dequeue
Loop
Else 'The keys exist in both tables
myQueueCount = oMine(oKey).Count
brokerQueueCount = oBroker(oKey).Count
If myQueueCount = brokerQueueCount Then
'Do nothing. They both have the same number of
'id's, and so we assume they are in sync.
Else
'Determine the minimum queue size, and get rid
'of that many values, since we won't need them
minQueue = IIf(myQueueCount < brokerQueueCount, myQueueCount, brokerQueueCount)
For i = 1 To minQueue
oMine(oKey).dequeue
oBroker(oKey).dequeue
Next i
'Take the remaining IDs out of the dictionary/queue that had more
If brokerQueueCount > myQueueCount Then
Set oMinQueue = oBroker
Else
Set oMinQueue = oMine
End If
Do While oMinQueue(oKey).Count > 0
DeserializeKey oKey, oMinQueue(oKey).dequeue
Loop
End If
End If
Next oKey
'The only remaining thing to test for is keys in the broker dict
'that are not in the myDict
For Each oKey In oBroker.keys
If Not oMine.Exists(oKey) Then
Do While oBroker(oKey).Count > 0
DeserializeKey oKey, oBroker(oKey).dequeue
Loop
End If
Next oKey
End Sub
Function GetDictionary(inputRange As Range) As Object
Dim oDict As Object
Dim sht As Worksheet
Dim cel As Range
Dim theKey As String
Dim oQueue As Object
Set sht = inputRange.Parent
Set oDict = CreateObject("Scripting.Dictionary")
For Each cel In Intersect(inputRange, sht.Columns(1))
theKey = GenerateKey(cel.Resize(, 5))
If oDict.Exists(theKey) Then
oDict(theKey).enqueue cel.Value
Else
Set oQueue = CreateObject("System.Collections.Queue")
oQueue.enqueue cel.Value
oDict.Add theKey, oQueue
End If
Next cel
Set GetDictionary = oDict
End Function
Sub DeserializeKey(ByVal theKey As String, theId As String)
'This is where you'd do some stuff to
'turn the key into individual cells, and store it.
'I'm only writing to the debug widnow to demonstrate
Debug.Print theId & " " & theKey
End Sub
Function GenerateKey(rng As Range) As String
GenerateKey = rng(2) & Format(rng(3), "0") _
& Format(rng(4), "0.00") & Format(rng(5), "mmddyyyy")
End Function
For those interested in this method, I'm editing this answer to add the "deserializekey" function:
Dim r As Long
Worksheets("Output").Activate
r = 1
'What we are doing here with "loopcell" is to check if the destination cells in the "output" sheet are empty or free.
'If not, we go down 1 row.
loopcell:
If IsEmpty(Range("A" & r).Value) = True Then
Range("A" & r).Value = "_" & theId & "_" & theKey
Else
r = r + 1
GoTo loopcell
End If
'The key is wrote to the the cell but we need to split every element of the key in multiple cells.
splitOutput = Range("A" & r).Value
splitArray = Split(splitOutput, "_")
For i = 1 To UBound(splitArray)
Cells(r, i).Value = splitArray(i)
Next i
Debug.Print theId & " " & theKey
End Sub ```
** New GetDictionary and Deserialize methods used to store more info **
Sub DeserializeKey(ByVal theKey As String, theId As Variant)
'This is where you'd do some stuff to
'turn the key into individual cells, and store it.
'I'm only writing to the debug widnow to demonstrate
Dim output As String
'Keep in mind that we have a 2d array, and we are reading
'one row at a time. So get the number of columns in the
'array, and then do whatever you need with them.
For i = LBound(theId, 2) To UBound(theId, 2)
output = output & " " & theId(1, i)
Next i
Debug.Print theKey & " -->" & output
End Sub
Function GetDictionary(inputRange As Range) As Object
Dim oDict As Object
Dim sht As Worksheet
Dim cel As Range
Dim theKey As String
Dim oQueue As Object
Dim columnCount As Long
Dim rngAsArray As Variant
Set sht = inputRange.Parent
'Get the column count of the input range. Since we don't
'hardcode it in, this function is more flexible to
'future changes
columnCount = inputRange.Columns.Count
Set oDict = CreateObject("Scripting.Dictionary")
For Each cel In Intersect(inputRange, sht.Columns(1))
theKey = GenerateKey(cel.Resize(, 5))
'Put the full row into an array, which we will then
'store as the content of the queue
rngAsArray = cel.Resize(, columnCount).Value
If oDict.Exists(theKey) Then
oDict(theKey).enqueue rngAsArray
Else
Set oQueue = CreateObject("System.Collections.Queue")
oQueue.enqueue rngAsArray
oDict.Add theKey, oQueue
End If
Next cel
Set GetDictionary = oDict
End Function
