Copy unique numbers

[Bagsy]

I’m Hoping somebody can help me out a bit here I have got something wrong in my code and am a completely out of my depth.
I have some code which I did several months ago with some help, but now realise that its not doing exactly what I really need.

I have in column B a list of the current months stock code numbers and column D the value of the item.
I need to then compare that to the list of stock code numbers from the previous month in column F with the value of the item in column H and enter the unique stock code numbers in column I. Then I need to subtract the current months value in column H, from the previous months value in column D, so I get a difference in value.

The problem is when we have new stock in the current month which is not in the previous month it is not entering the unique stock number in column I. Then I would need to subtract zero as none has been used.
Any help would really be appreciated
The part of the code which isn’t working below.

' initial comparing data & copying Unique stock numbers & values into a separate list
   Dim Cl As Range
   Dim Ws As Worksheet
   Set Ws = Sheets(1)
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("B5", Ws.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Value
      Next Cl
      For Each Cl In Ws.Range("F5", Ws.Range("F" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            Cl.Offset(, 3).Resize(, 2).Value = Array(Cl.Value, .Item(Cl.Value) - Cl.Offset(, 2).Value)
         End If
      Next Cl
   End With

 

[Fluff]

How about

' initial comparing data & copying Unique stock numbers & values into a separate list
   Dim Cl As Range
   Dim Ws As Worksheet
   Set Ws = Sheets(1)
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("B5", Ws.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Value
      Next Cl
      For Each Cl In Ws.Range("F5", Ws.Range("F" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            Cl.Offset(, 3).Resize(, 2).Value = Array(Cl.Value, .Item(Cl.Value) - Cl.Offset(, 2).Value)
            .Remove Cl.Value
         End If
      Next Cl
      If .Count > 0 Then
         Ws.Range("F" & Rows.Count).End(xlUp).Offset(1, 3).Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
      End If
   End With

 

[Bagsy]

How about

' initial comparing data & copying Unique stock numbers & values into a separate list
   Dim Cl As Range
   Dim Ws As Worksheet
   Set Ws = Sheets(1)
  
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("B5", Ws.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Value
      Next Cl
      For Each Cl In Ws.Range("F5", Ws.Range("F" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            Cl.Offset(, 3).Resize(, 2).Value = Array(Cl.Value, .Item(Cl.Value) - Cl.Offset(, 2).Value)
            .Remove Cl.Value
         End If
      Next Cl
      If .Count > 0 Then
         Ws.Range("F" & Rows.Count).End(xlUp).Offset(1, 3).Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
      End If
   End With

I cannot thank you enough Fluff, that is exactly as I need it, once again you have stepped in when I needed it.

 

[Fluff]

You're welcome & thanks for the feedback.