VBA to paste number in first empty cell if conditions are met

[smide]

Hello.

In row 3 (Sheet1) I have products names (every second column) and list of their prices (below product names). New obtained price for each product is also in row 3 and always in "right" column.

I need a VBA to check whether this new obtained product's price is different from the last (active) price (last price in that column).
If this price is different then paste it in first empty cell in that column.

Example.

* new obtained prices are in cells C3,E3,G3...

Sheet1 (before macro run)

	A	B	C	D	E	F	G	H
1
2
3		Product1	35	Product2	59	Product3	33	....
4		18		19		17
5		22		25		29
6				36		33
7

<tbody>
</tbody>

Sheet1 (after macro run)

	A	B	C	D	E	F	G	H
1
2
3		Product1	35	Product2	59	Product3	33	....
4		18		19		17
5		22		25		29
6		35		36		33
7				59

<tbody>
</tbody>

* obtained price for Product 3 is the same as last price - don't add value 33 again in Product 3 column (!)

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG22Sep07
[COLOR="Navy"]Dim[/COLOR] rLst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] cLst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
cLst = Cells("3", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]For[/COLOR] Ac = 2 To cLst [COLOR="Navy"]Step[/COLOR] 2
    [COLOR="Navy"]If[/COLOR] Cells(3, Ac + 1) > Cells(Rows.Count, Ac).End(xlUp).Value [COLOR="Navy"]Then[/COLOR]
        Cells(Rows.Count, Ac).End(xlUp).Offset(1).Value = Cells(3, Ac + 1)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[smide]

Try this:-

[COLOR=Navy]Sub[/COLOR] MG22Sep07
[COLOR=Navy]Dim[/COLOR] rLst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] cLst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
cLst = Cells("3", Columns.Count).End(xlToLeft).Column
[COLOR=Navy]For[/COLOR] Ac = 2 To cLst [COLOR=Navy]Step[/COLOR] 2
    [COLOR=Navy]If[/COLOR] Cells(3, Ac + 1) > Cells(Rows.Count, Ac).End(xlUp).Value [COLOR=Navy]Then[/COLOR]
        Cells(Rows.Count, Ac).End(xlUp).Offset(1).Value = Cells(3, Ac + 1)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Thanks for reply.
There is a problem with macro if new obtained price is less than last price (it does not copy it) ...
Any idea how to fix this?

 

[MickG]

Change :-

 If Cells(3, Ac + 1) [B][COLOR=#FF0000]<>[/COLOR][/B] Cells(Rows.Count, Ac).End(xlUp).Value Then

 

[shreif]

Sub new_one()
    Dim x, c As Long
    x = Range("b3").End(xlToRight).Column
    For c = 2 To x Step 2
        If Not Cells(Rows.Count, c).End(xlUp) = Cells(Rows.Count, c + 1).End(xlUp) Then
            Cells(Rows.Count, c).End(xlUp).Offset(1) = Cells(Rows.Count, c + 1).End(xlUp)
        End If
    Next c
End Sub

 

[smide]

Thank you.

 

[MickG]

You're welcome