1) Sheet name A, B and Final
2) Data should begin from A2 and heading from B1 in row1
Sub test()
Dim a, e, i As Long, ii As Long, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMOde = 1
a = Sheets("a").Cells(1).CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
.CompareMOde = 1
For Each e In Array("A", "B")
a = Sheets(e).Cells(1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
.Item(a(i, 1)).CompareMOde = 1
End If
For ii = 2 To UBound(a, 1)
If Not dic.exists(a(1, ii)) Then dic(a(1, ii)) = Empty
.Item(a(i, 1))(a(1, ii)) = IIf(IsEmpty(.Item(a(i, 1))(a(1, ii))), _
a(i, ii), Application.Min(a(i, ii), .Item(a(i, 1))(a(1, ii))))
Next
Next
Next
ReDim a(1 To .Count + 1, 1 To dic.Count + 1)
For ii = 0 To dic.Count - 1
a(1, ii + 2) = dic.keys()(ii)
Next
For i = 0 To .Count - 1
a(i + 2, 1) = .keys()(i)
For ii = 2 To UBound(a, 2)
a(i + 2, ii) = .Items()(i)(a(1, ii))
Next
Next
End With
Sheets("final").Cells(1).CurrentRegion.Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub
If this doesn't work, need to see your workbook.
Bookmarks