Compare values from one list to the corresponding line on another list.

[Bagsy]

I wonder if somebody can help me out a bit here, please.
I have two stock lists this month and previous month. This month is pasted into columns A5, B5, C5 and the previous month pasted into columns E5, F5, G5, columns A & E are unique code numbers, C & G are the value of the stock, B & F just a description.
What I have been trying to do is copy the values for each unique number & paste them into column H against the row with the corresponding unique number, I can then enter a formula in column I to determine the difference between the two values, or even better just paste the difference in values in column I.

I think I have got the code to work as far as copying the value from the current month, but I am struggling to paste it in the row corresponding to the unique number for the previous month.
Any help is always appreciated
Code below

Sub compareStockValue()
Dim sh As Worksheet, lr As Long, fVal As Range, c As Range
    Set sh = Sheets(1) 'Edit sheet name
    lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        For Each c In sh.Range("E5:E1500") 'Assumes header rows
            Set fVal = sh.Range("A5:A" & lr).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not fVal Is Nothing Then
                    fAdr = fVal.Address
                    Do
                    c.Interior.ColorIndex = 6
                    fVal.Interior.ColorIndex = 6
                    fVal.Value = c.Value
                    fVal.Offset(0, 2).Copy 'copying the current month stock value
                    Set fVal = sh.Range("A5:A" & lr).FindNext(fVal)
                    Loop While fVal.Address <> fAdr
                End If
        Next
        Application.CutCopyMode = False
End Sub

 

[Fluff]

How about

Sub Bagsy()
   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = Sheets(1)
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("A5", Ws.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Value
      Next Cl
      For Each Cl In Ws.Range("E5", Ws.Range("E" & 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
End Sub

 

[Peter_SSs]

Would you consider doing it without the looping?

Sub CompareValues()
  With Sheets(1)
    With .Range("I5:I" & .Range("E" & Rows.Count).End(xlUp).Row)
      .Formula = "=VLOOKUP(E5,A$5:C$" & .Parent.Cells(Rows.Count, 1).End(xlUp).Row & ",3,0)- G5"
      .Value = .Value
    End With
  End With
End Sub

 

[Bagsy]

How about

Sub Bagsy()
   Dim Cl As Range
   Dim Ws As Worksheet
  
   Set Ws = Sheets(1)
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("A5", Ws.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 2).Value
      Next Cl
      For Each Cl In Ws.Range("E5", Ws.Range("E" & 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
End Sub

That is amazing Fluff thank you so much

 

[Fluff]

Glad we could help & thanks for the feedback.