Closing Stock Report With Parameters

[littleiitin]

Try Below code:

Sub DetailedSumary()

Dim strSheetName        As String
Dim rngSumCell          As Range
Dim rngPurCell          As Range
Dim rngSellCell         As Range
    With ThisWorkbook.Worksheets("Purchase")
       .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
    End With
    Sheets.Add After:=Sheets(Sheets.Count)
    strSheetName = ActiveSheet.Name
    With ThisWorkbook.Worksheets(strSheetName)
        .Range("A1").PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        .Range("$A$1:$A" & .Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("$A$1:$A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
    End With

    With ThisWorkbook.Worksheets("Summary")
     .Range("A2").PasteSpecial xlPasteValues
    End With
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(strSheetName).Delete
    Application.DisplayAlerts = True
    
    Dim lngMorethan60DaysPur   As Long
    Dim lngTotalPur            As Long
    Dim lngTotalSal            As Long
    Dim j                      As Long
    Dim k                      As Long
    With ThisWorkbook.Worksheets("Summary")
           .Range("A1").CurrentRegion.Offset(1, 1).ClearContents
           For Each rngSumCell In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row + 1)
            For Each rngPurCell In ThisWorkbook.Worksheets("Purchase").Range("A3:A" & ThisWorkbook.Worksheets("Purchase").Range("A" & Rows.Count).End(xlUp).Row + 1)
                If rngPurCell.Value = rngSumCell.Value Then
                    j = 1
                    If Now() - rngPurCell.Offset(, 2) >= 60 Then
                     lngMorethan60DaysPur = lngMorethan60DaysPur + rngPurCell.Offset(, 3)
                    End If
                    lngTotalPur = lngTotalPur + rngPurCell.Offset(, 3)
                ElseIf rngPurCell.Value <> rngSumCell.Value And j = 1 Then
                    rngSumCell.Offset(, 1) = lngTotalPur
                    rngSumCell.Offset(, 6) = lngMorethan60DaysPur
                    lngTotalPur = 0
                    lngMorethan60DaysPur = 0
                    j = 0
                    GoTo Sale:
                End If
            Next rngPurCell
Sale:
            For Each rngSellCell In ThisWorkbook.Worksheets("Sales").Range("A2:A" & ThisWorkbook.Worksheets("Sales").Range("A" & Rows.Count).End(xlUp).Row + 1)
                 If rngSellCell.Value = rngSumCell.Value Then
                    lngTotalSal = lngTotalSal + rngSellCell.Offset(, 3)
                    k = 1
                 ElseIf rngSellCell.Value <> rngSumCell.Value And k = 1 Then
                     rngSumCell.Offset(, 2) = lngTotalSal
                     lngTotalSal = 0
                     k = 0
                     GoTo Purchase:
                 End If
            Next rngSellCell
Purchase:
        Next rngSumCell
        
        For Each rngSumCell In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
          
          If rngSumCell.Offset(, 1) - rngSumCell.Offset(, 2) > 0 Then
            rngSumCell.Offset(, 3) = rngSumCell.Offset(, 1) - rngSumCell.Offset(, 2)
          Else
            rngSumCell.Offset(, 3) = 0
          End If
          
          If rngSumCell.Offset(, 6) - rngSumCell.Offset(, 2) > 0 Then
            rngSumCell.Offset(, 4) = rngSumCell.Offset(, 6) - rngSumCell.Offset(, 2)
          Else
            rngSumCell.Offset(, 4) = ""
          End If
          rngSumCell.Offset(, 6) = ""
           If rngSumCell.Offset(, 3) - rngSumCell.Offset(, 4) > 0 Then
            rngSumCell.Offset(, 5) = rngSumCell.Offset(, 3) - rngSumCell.Offset(, 4)
          Else
            rngSumCell.Offset(, 5) = 0
          End If
        Next
        
        
    End With
    
    

End Sub