View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Mike H Mike H is offline
external usenet poster
 
Posts: 11,501
Default Macro that compares columns and identifies changes

tidied up a bit

Sub stance()
Dim Lastrow As Long
Dim Newprice As Variant
Dim OldPrice As Variant
Lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Set MyRange = Range("C1:C" & Lastrow)
For Each c In MyRange
Newprice = WorksheetFunction.VLookup(c.Value, Range("C1:D100"), 2, False)
On Error Resume Next
OldPrice = WorksheetFunction.VLookup(c.Value, Range("A1:B100"), 2, False)
If WorksheetFunction.CountIf(Range("A:A"), c.Value) = 0 Then
c.Offset(, 2) = "New item"
ElseIf WorksheetFunction.CountIf(Range("A:A"), c) 0 And OldPrice <
Newprice Then
c.Offset(, 2) = c.Offset(, 1).Value
Else
c.Offset(, 2) = "Same price"
End If
If WorksheetFunction.CountIf(Range("C:C"), c.Offset(, -2).Value) = 0 Then
c.Offset(, 3) = "Deleted item"
End If
Next
End Sub


Mike

"Mike H" wrote:

Hi,

I think this covers it

Sub stance()
Dim MyRange
Dim copyrange As Range
lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Set MyRange = Range("C1:C" & lastrow)
For Each c In MyRange
newprice = WorksheetFunction.VLookup(c.Value, Range("C1:D100"), 2, False)
On Error Resume Next
oldprice = WorksheetFunction.VLookup(c.Value, Range("A1:B100"), 2, False)
newitem = WorksheetFunction.VLookup(c.Offset(, -2), Range("A1:B100"), 2,
False)
If WorksheetFunction.CountIf(Range("A:A"), c.Value) = 0 Then
c.Offset(, 2) = "New item"
ElseIf WorksheetFunction.CountIf(Range("A:A"), c) 0 And oldprice <
newprice Then
c.Offset(, 2) = c.Offset(, 1).Value
Else
c.Offset(, 2) = "Same price"
End If

If WorksheetFunction.CountIf(Range("C:C"), c.Offset(, -2).Value) = 0 Then
c.Offset(, 3) = "Deleted item"
End If
Next
End Sub


mike

"andrei" wrote:

The F column has nothing to do with whats in E column . Only says that them
item in A column is not to be found in C column




"andrei" wrote:

E1 : new item
E2 : 380.90
E3 : same price

F1 : empty cell
F2 : deleted item
F3 : empty cell