Hi Prabhu,

Try this one.

Code:
Option Explicit

Sub kTest()
    
    Dim wksPurch        As Worksheet, wksSales  As Worksheet, dtCurrent As Date
    Dim ka, k(), i As Long, n As Long, t(), wksSummary As Worksheet
    
    Set wksPurch = Worksheets("Purchase")
    Set wksSales = Worksheets("Sales")
    Set wksSummary = Worksheets("Summary")
    
    i = wksPurch.UsedRange.Rows.Count + wksSales.UsedRange.Rows.Count
    ReDim k(1 To i, 1 To 6)
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        dtCurrent = wksPurch.Range("b1")
        ka = wksPurch.Range("a1").CurrentRegion.Resize(, 5).Offset(1)
        For i = 2 To UBound(ka, 1)
            If Len(ka(i, 1)) * Len(ka(i, 3)) Then
                If Not .exists(Trim$(ka(i, 1))) Then
                    n = n + 1
                    k(n, 1) = Trim$(ka(i, 1))
                    k(n, 2) = ka(i, 4)
                    If dtCurrent - CDate(ka(i, 3)) > 60 Then k(n, 5) = ka(i, 4)
                    k(n, 4) = "=RC[-2]-RC[-1]"
                    k(n, 6) = "=RC[-2]-RC[-1]"
                    .Add Trim$(ka(i, 1)), Array(n, 6)
                Else
                    t = .Item(Trim$(ka(i, 1)))
                    k(t(0), 2) = k(t(0), 2) + ka(i, 4)
                    If dtCurrent - CDate(ka(i, 3)) > 60 Then
                        k(t(0), 5) = k(t(0), 5) + ka(i, 4)
                    End If
                End If
            End If
        Next
        ka = wksSales.Range("a1").CurrentRegion.Resize(, 5)
        For i = 2 To UBound(ka, 1)
            If Len(ka(i, 1)) * Len(ka(i, 3)) Then
                If .exists(Trim$(ka(i, 1))) Then
                    t = .Item(Trim$(ka(i, 1)))
                    k(t(0), 3) = k(t(0), 3) + ka(i, 4)
                    k(t(0), 5) = Application.Max(0, k(t(0), 5) - ka(i, 4))
                End If
            End If
        Next
    End With
    If n Then
        With wksSummary
            .Range("a2").Resize(n, 6).Value = k
        End With
    End If
        
End Sub