Macro for purchasing grouped items calulation

In your example, I believe pears actually work out to a profit of 96?

If I understood the requirement correctly:

Sub fruit()

Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim myDictionary As Scripting.dictionary

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Set myDictionary = CreateObject("scripting.dictionary")

For i = lr To 2 Step -1
    If Not myDictionary.Exists(ws.Range("A" & i).Value) Then
        myDictionary.Add ws.Range("A" & i).Value, ws.Range("D" & i).Value - ws.Range("C" & i).Value
    Else
        myDictionary(ws.Range("A" & i).Value) = myDictionary(ws.Range("A" & i).Value) + ws.Range("D" & i).Value - ws.Range("C" & i).Value
    End If
    If ws.Range("C" & i).Value = vbNullString Then
        ws.Range("E" & i).Value = myDictionary(ws.Range("A" & i).Value)
        If myDictionary(ws.Range("A" & i).Value) < 0 Then
            ws.Range("E" & i).Font.Color = vbRed
        Else
            ws.Range("E" & i).Font.Color = vbGreen
        End If
    Else
        ws.Range("E" & i).Font.Color = vbBlack
    End If
Next i

Application.ScreenUpdating = True

End Sub

But Pears also have a sell at 543 on row #4...
Maybe I did not understand well... do we ignore "sell at" until there is no "buy at" value?

Well, if you delete that value, my previous code should work... but to avoid errors, I can just ignore "D" if "C" has a value:

Sub fruit()

Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim myDictionary As Object

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Set myDictionary = CreateObject("Scripting.Dictionary")

For i = lr To 2 Step -1
    If Not myDictionary.Exists(ws.Range("A" & i).Value) Then
        myDictionary.Add ws.Range("A" & i).Value, -1 * ws.Range("C" & i).Value
    Else
        myDictionary(ws.Range("A" & i).Value) = myDictionary(ws.Range("A" & i).Value) + IIf(ws.Range("C" & i).Value = vbNullString, ws.Range("D" & i).Value, -1 * ws.Range("C" & i).Value)
    End If
    If ws.Range("C" & i).Value = vbNullString Then
        ws.Range("E" & i).Value = myDictionary(ws.Range("A" & i).Value)
        If myDictionary(ws.Range("A" & i).Value) < 0 Then
            ws.Range("E" & i).Font.Color = vbRed
        Else
            ws.Range("E" & i).Font.Color = vbGreen
        End If
    Else
        ws.Range("E" & i).Font.Color = vbBlack
    End If
Next i

Application.ScreenUpdating = True

End Sub

The code DOES assume that the first instance (when working from the bottom to the top) of any fruit will have a buying price.

Yeah, I don't think that is a problem, just didn't know that was a requirement. Give this a go (added one line, which is in red in the code below):

Sub fruit()

Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim myDictionary As Object

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Set myDictionary = CreateObject("Scripting.Dictionary")

For i = lr To 2 Step -1
    If Not myDictionary.Exists(ws.Range("A" & i).Value) Then
        myDictionary.Add ws.Range("A" & i).Value, -1 * ws.Range("C" & i).Value
    Else
        myDictionary(ws.Range("A" & i).Value) = myDictionary(ws.Range("A" & i).Value) + IIf(ws.Range("C" & i).Value = vbNullString, ws.Range("D" & i).Value, -1 * ws.Range("C" & i).Value)
    End If
    If ws.Range("C" & i).Value = vbNullString Then
        ws.Range("E" & i).Value = myDictionary(ws.Range("A" & i).Value)
        myDictionary.Remove (ws.Range("A" & i).Value)
        If myDictionary(ws.Range("A" & i).Value) < 0 Then
            ws.Range("E" & i).Font.Color = vbRed
        Else
            ws.Range("E" & i).Font.Color = vbGreen
        End If
    Else
        ws.Range("E" & i).Font.Color = vbBlack
    End If
Next i

Application.ScreenUpdating = True

End Sub

my bad... changed it back to Dim ... As Object... it was just for testing that I had it as scripting dictionary. It is a dictionary, but by using dim as object we don't need to add a reference to the library. Sorry about that, I updated my post with code.

jamesbarb,

Thanks for taking the time I'm happy I could help you out. If you are satisfied with the solution, could I ask you to mark the thread as solved? Have a great day, and good luck with the project