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

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
413
Office Version
  1. 365
Platform
  1. Windows
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
VBA Code:
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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,791
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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
 
Solution

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,757
Office Version
  1. 365
Platform
  1. Windows
Would you consider doing it without the looping?

VBA Code:
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

Active Member
Joined
Feb 26, 2005
Messages
413
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,791
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Forum statistics

Threads
1,147,818
Messages
5,743,382
Members
423,792
Latest member
travisds

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top