Macro to subtract items and delete rows based on Criteria

[howard]

I have data on sheet reconciling items

I have tried to write code to do the following


1) Where the reference is the same then subtract the values from each other and where the difference is <=1, then show the result next to the first reference and delete the row containing the duplicate reference
2 Where one value is positive and the other value is negative and the references are the same , then add the values, and where the difference is <=1, then show the result and delete the row containing the duplicate reference


I have shown what the result should look like on sheet "Final Result"

See link below containing sample data

Dropbox - File Deleted - Simplify your life

www.dropbox.com

See my code below

 Sub getSubtractedValues()
Dim dic As Object, k&, i&, j&, d, r As Range, c As Range, f
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("reconciling Items")
    i = .Cells(Rows.Count, 1).End(xlUp).Row
    For Each r In .Range("c2:c" & i)
        If Not dic.exists(r.Value) Then
            dic.Add r.Value, r.Offset(, -2).Value & "|" & r.Offset(, -1).Value & "|" & r.Value & "|" & r.Offset(, 1).Value
        Else
            If (Split(dic(r.Value), "|")(3) < 0 And r.Offset(, 1).Value > 0) Or (Split(dic(r.Value), "|")(3) > 0 And r.Offset(, 1).Value < 0) Then
                If (Split(dic(r.Value), "|")(3) + r.Offset(, 1).Value) <= 1 Then
                    dic(r.Value) = Split(dic(r.Value), "|")(0) & "|" & Split(dic(r.Value), "|")(1) & "|" & Split(dic(r.Value), "|")(2) & "|" & Split(dic(r.Value), "|")(3) + r.Offset(, 1).Value
                End If
            Else
                If (Split(dic(r.Value), "|")(3) - r.Offset(, 1).Value) <= 1 Then
                    dic(r.Value) = Split(dic(r.Value), "|")(0) & "|" & Split(dic(r.Value), "|")(1) & "|" & Split(dic(r.Value), "|")(2) & "|" & Split(dic(r.Value), "|")(3) - r.Offset(, 1).Value
                End If
            End If
        End If
    Next r
End With
With Sheets("Final Result")
    .UsedRange.Offset(1).ClearContents
    .[a2].Resize(dic.Count).Value = Application.Transpose(Array(dic.items))
    .Range("a2:a" & dic.Count + 1).TextToColumns Destination:=.Range("A2"), DataType:=xlDelimited, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
End With
End Sub

i have also posted yesterday on Macro to subtract values where Ref is the same and diff value does not exceed 1.00