VBA Excel: Sum Duplicates w/ 3 Variables

Question

My question is for VBA Excel. I have a data set that is similar to this: (Edited)

Order Number Description                    Item Code    Value
AA000001     Mopping Service Payment    00001            100.00
AA000001     Mopping Service Discount   00001            -50.00
AA000001     Bucket Rental                  00002             50.00
AA000001     Bucket Rental Discount     00002            -25.00
AA000001     Mopping Service Payment        00001             25.00
AA000001     Bucket Rental                  00002             10.00
AA000002     Mopping Service Payment    00001            100.00
AA000002     Mopping Service Discount   00001            -50.00
AA000002     Bucket Rental                  00002             50.00
AA000002     Bucket Rental Discount     00002            -25.00

What I would like for output:

Order Number Description                    Item Code    Value
AA000001     Mopping Service Payment    00001             75.00
AA000001     Bucket Rental                  00002             35.00
AA000002     Mopping Service Payment    00001             50.00
AA000002     Bucket Rental                  00002             25.00

I found the following code on the interwebs, and modified it slightly, but my problem is it has no logic in it for just combining duplicates based on an order number (instead, it is replacing all the item codes with the same value regardless of Order Number.) Is there a way to add in code to take all the item codes that are similar for a given order number and sum them?

What do I need to add? What am I missing? Thanks in advance!

    Dim Sh As Worksheet
    Dim LastRow As Long 
    Dim Rng As Range
    Set Sh = Worksheets(1)
    Sh.Columns(5).Insert
    LastRow = Sh.Range("A65536").End(xlUp).Row
    With Sh.Range("A1:A" & LastRow).Offset(0, 4)
        .FormulaR1C1 = "=IF(COUNTIF(R1C[-2]:RC[-2],RC[-2])>1,"""",SUMIF(R1C[-2]:R[" & LastRow & "]C[-2],RC[-2],R1C[-1]:R[" & LastRow & "]C[-1]))"
        .Value = .Value
    End With
    Sh.Columns(4).Delete
    Sh.Rows(1).Insert
    Set Rng = Sh.Range("D1:D" & LastRow + 1)
    With Rng
        .AutoFilter Field:=1, Criteria1:="="
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

Answer 1

This code matches the items by combining strings of order number and product code, does the calculations and removes the rows containing discounts. Hope it works for you

Option Explicit

Sub Combine__And__Delete()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim ws As Worksheet
    Set ws = Sheets(1)

    Dim i&, j&, lr&, rng As Range, nrng As Range, str$, com$, x#, y#
    lr = ws.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
        Set rng = ws.Range("A" & i): str = rng.Text & rng.Offset(0, 2).Text
        For j = 2 To lr
            If i <> j Then
                Set nrng = ws.Range("A" & j): com = nrng.Text & nrng.Offset(0, 2).Text
                If StrComp(str, com, 1) = 0 Then
                    x = CDbl(rng.Offset(0, 3)): y = CDbl(nrng.Offset(0, 3))
                    If y < 0 Then
                        rng.Offset(0, 4) = CDbl(rng.Offset(0, 3)) - Abs(CDbl(nrng.Offset(0, 3)))
                    End If
                End If
                Set nrng = Nothing
            End If
        Next j
        Set rng = Nothing
    Next i
    For i = lr To 2 Step -1
        Set rng = ws.Range("E" & i)
            If rng.Value < 0 Then Rows(rng.Row & ":" & rng.Row).Delete
        Set rng = Nothing
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

EDIT:
I have changed the code a bit to better match your criteria. Try it and leave feedback:)

Option Explicit

Sub Combine__And__Delete()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim ws As Worksheet
    Set ws = Sheets(1)

    Dim i&, j&, lr&, rng As Range, str$, com$, tmp, x#
    lr = ws.Range("A" & Rows.Count).End(xlUp).Row
    ReDim arr(lr - 2) As String
    For i = 2 To lr
        Set rng = ws.Range("A" & i)
        arr(i - 2) = rng.Text & "###" & rng.Offset(0, 2).Text
        Set rng = Nothing
    Next i

    Call RemoveDuplicate(arr)

    For i = LBound(arr) To UBound(arr)
        For j = lr To 2 Step -1
            Set rng = ws.Range("A" & j)
            str = rng.Text & "###" & rng.Offset(0, 2).Text
            If StrComp(str, arr(i), 1) = 0 Then
                x = x + CDbl(rng.Offset(0, 3).Value)
                com = rng.Offset(0, 1)
            End If
            Set rng = Nothing
        Next j
        arr(i) = arr(i) & "###" & CStr(x) & "###" & com
        x = 0
    Next i

    Rows("2:" & lr).Delete

    For i = LBound(arr) To UBound(arr)
        Set rng = ws.Range("A" & i + 2)
        tmp = Split(arr(i), "###")
        rng = tmp(0)
        rng.Offset(0, 1) = tmp(3)
        rng.Offset(0, 2) = tmp(1)
        rng.Offset(0, 3) = tmp(2)
        Set rng = Nothing
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub


Sub RemoveDuplicate(ByRef StringArray() As String)
    Dim lb&, ub&, TempArray() As String, cur&, A&, B&
    If (Not StringArray) = True Then Exit Sub
    lb = LBound(StringArray): ub = UBound(StringArray)
    ReDim TempArray(lb To ub): cur = lb: TempArray(cur) = StringArray(lb)
    For A = lb + 1 To ub
        For B = lb To cur
            If LenB(TempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), TempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        If B > cur Then cur = B: TempArray(cur) = StringArray(A)
    Next A
    ReDim Preserve TempArray(lb To cur): StringArray = TempArray
End Sub