Code:
Option Explicit
Sub kTest()
Dim k(1), kk(1), dic As Object, i As Long
Dim s As String, n(1) As Long, c As Long, j As Long
Dim kkk0, kkk1
With Worksheets("DataSummary")
k(0) = .[b1].CurrentRegion.Resize(, 8).Value 'assume no data in col A
k(1) = .[k1].CurrentRegion.Value 'assume no data in col J
End With
With Worksheets("PivotDaily")
kk(0) = .[b5].CurrentRegion.Resize(, 8).Value 'assume no data in col A
kk(1) = .[k5].CurrentRegion.Value 'assume no data in col J
End With
ReDim kkk0(1 To UBound(k(0), 1) + UBound(kk(0), 1), 1 To UBound(k(0), 2))
ReDim kkk1(1 To UBound(k(1), 1) + UBound(kk(1), 1), 1 To UBound(k(1), 2))
Set dic = CreateObject("scripting.dictionary"): dic.comparemode = 1
For j = 0 To 1
For i = 1 To UBound(k(j), 1)
If j = 0 Then
s = k(j)(i, 1) & k(j)(i, 2) & k(j)(i, 3) & k(j)(i, 4) & k(j)(i, 5) & k(j)(i, 8)
Else
s = vbNullString
For c = 1 To UBound(k(j), 2)
s = s & "|" & k(j)(i, c)
Next
End If
For c = 1 To UBound(k(j), 2)
If j = 0 Then
kkk0(i, c) = k(j)(i, c)
Else
kkk1(i, c) = k(j)(i, c)
End If
Next
dic.Item(s) = i
Next
n(j) = i - 1
Next
For j = 0 To 1
For i = 1 To UBound(kk(j), 1)
If j = 0 Then
s = kk(j)(i, 1) & kk(j)(i, 2) & kk(j)(i, 3) & kk(j)(i, 4) & kk(j)(i, 5) & kk(j)(i, 8)
Else
s = vbNullString
For c = 1 To UBound(kk(j), 2)
s = s & "|" & kk(j)(i, c)
Next
End If
If Not dic.exists(s) Then
n(j) = n(j) + 1
For c = 1 To UBound(kk(j), 2)
If j = 0 Then
kkk0(n(j), c) = kk(j)(i, c)
Else
kkk1(n(j), c) = kk(j)(i, c)
End If
Next
dic.Item(s) = i
End If
Next
Next
With Worksheets("DataSummary")
.[b1].Resize(n(0), UBound(k(0), 2)).Value = kkk0
.[k1].Resize(n(1), UBound(k(1), 2)).Value = kkk1
End With
End Sub
Bookmarks