Macro that compares columns and identifies changes

[andrei]

Let's say i have column A with items , column B with prices , column C with
items and column D with prices again . Items in column A are in column C but
not all of them . Items it column C are in column A but not all of them .
Prices in column D are the current ones .


Example :

A1 : fork
A2 : spoon
A3 : computer

B1 : 2.20
B2 : 1.90
B3 : 400.50

C1 : TV
C2 : computer
C3 : fork


D1 : 190
D2 : 380.90
D3 : 2.20

In E column i want the macro to do this :

E1 : "TV" (item from C1) not found in A column , puts in E1 this code "new
item"

E2 : "computer" (item from C2) found in A column but with different price .
Puts in E2 the price from D2 : "380.90"

E3 : "fork" (item from C3 ) found in A column with same price ( D3=B1) .
Puts in E3 this code "same price"

After that it analises the items which are in A column but not to be found
in C column and puts in F column a code "deleted item "

"spoon" from A2 is not to be found in C column . So , in F2 the cod should
be "deleted item"


Can this be done ?

 

[Mike H]

Hi,

I'm sure this is dooable but I cant get my head around what columns E & F
should look like after the code has run so using your sample data please post
what these 2 columns should look like.

Mike

 

[andrei]

E1 : new item
E2 : 380.90
E3 : same price

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

 

[andrei]

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

 

[Mike H]

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("C1100"), 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

 

[Mike H]

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("C1100"), 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

 

[andrei]

gives me an error :

compile error
Syntax error

ElseIf WorksheetFunction.CountIf(Range("A:A"), c) > 0 And OldPrice <>
Newprice Then

It seems that it has a problem with this

 

[Mike H]

Hi,

That's a simple line-wrap problem

ElseIf WorksheetFunction.CountIf(Range("A:A"), c) > 0 And OldPrice <>
Newprice Then

Put the cursor to the left op the N in Newprice and tap backspace to put all
the code on 1 line

you can use this version where there should be no linewraps

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("C1100"), 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

 

[andrei]

I tried the last macro you gave , but i have in every cell in column E "new
item" and in every cell in column F "deleted item"

 

[Mike H]

Hi,

You will get that if the text desriptions in columns A & C aren't the same,
capitalisation desn't matter, it's spaces at the start or end that usually
give the problem.

Run this macro on the data to remove spaces

Sub cleanup()
Lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For x = 1 To Lastrow
Cells(x, 1).Value = Trim(Cells(x, 1).Value)
Cells(x, 3).Value = Trim(Cells(x, 1).Value)
Next
End Sub


Mike

 

[andrei]

thanks ! it works !

 

[Mike H]

Glad i could help and thanks for the feedback