VBA to copy, multiply, roundup and paste values

[Supernerd81]

Hi,
I am trying to automate our price increases. Unfortulately I don't know much about excel vba. What I want:
Take the old price in column C, multiply by the value in F2, roundup to the nearest 10 and paste it in column B.
I am currently using a formula which I copy paste every row:

=ROUNDUP((C2*$F$2);-1)

I am trying to automate this with a macro, but thus far I have no succes. This is what I have:

Sub Copypaste()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("C2:C200")
For Each cel In SrchRng
    If cel.Value <> "" Then
        cel.Offset(0, -1).Value = cel.Value
    End If
Next cel
End Sub

This at least copies my values in column B (and leaves the 'price on request') but I still have to multiply the entire column. Does anyone have a suggestion on how I can do that? The simple ROUNDUP function doesn't seem to work in VBA?

Thanks!

 

[Legacy 143009]

How about:

Sub test()
  Dim oldPrices As Variant, newPrices As Variant, increaseRatio As Double
  With Application
  oldPrices = .Transpose(Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row))
  ReDim newPrices(1 To UBound(oldPrices), 1 To 1)
  increaseRatio = Range("F2").Value2
  
  For i = 1 To UBound(oldPrices)
    If IsNumeric(oldPrices(i)) Then
      newPrices(i, 1) = .WorksheetFunction.RoundUp(oldPrices(i) * increaseRatio, -1)
    Else
       newPrices(i, 1) = oldPrices(i)
    End If
  Next
  End With
  
  Range("B2").Resize(UBound(newPrices)) = newPrices
End Sub

 

[Supernerd81]

Wow that works, but I have no idea what it does!
I changed your code because you used column D, this should be C.

Thanks a lot!

 

[kevin9999]

Another option using Evaluate. I'm not sure where you get 140 from for potato (?) doesn't seem to be 125 * 1.05 ?!

Code

Option Explicit
Sub Supernerd81()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Dim x As Double
    x = ws.Range("F2").Value
    
    With ws.Range("B2:B" & Cells(Rows.Count, "C").End(xlUp).Row)
        .Value = Evaluate("IF(isnumber(" & .Offset(0, 1).Address & "),Roundup(" & .Offset(0, 1).Address & "*" & x & ",2)," & .Offset(0, 1).Address & ")")
    End With
End Sub

Before

Book1
	A	B	C	D	E	F
1		Old Price	Old Price
2	Apple		€ 2.250		increase prices by	1.05
3	Pear		€ 3.250
4	Banana		Price on request
5	Tomato		€ 11.590
6	Potato		€ 125
Sheet1

After

Book1
	A	B	C	D	E	F
1		Old Price	Old Price
2	Apple	€ 2.370	€ 2.250		increase prices by	1.05
3	Pear	€ 3.420	€ 3.250
4	Banana	Price on request	Price on request
5	Tomato	€ 12.170	€ 11.590
6	Potato	€ 131	€ 125
Sheet1

 

[Legacy 143009]

Wow that works, but I have no idea what it does!
I changed your code because you used column D, this should be C.

Thanks a lot!

Oh my bad.. I am glad you have managed. Thanks for the feedback

 

[kevin9999]

I just realised that it's your separators that's confusing me (Doh!). Try this instead

Option Explicit
Sub Supernerd81()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Dim x As Double
    x = ws.Range("F2").Value
   
    With ws.Range("B2:B" & Cells(Rows.Count, "C").End(xlUp).Row)
        .Value = Evaluate("IF(isnumber(" & .Offset(0, 1).Address & "),Roundup(" & .Offset(0, 1).Address & "*" & x & ",-1)," & .Offset(0, 1).Address & ")")
    End With
End Sub

Before

supernerd81.xlsm
	A	B	C	D	E	F
1		Old Price	Old Price
2	Apple		2,250		increase prices by	1.05
3	Pear		3,250
4	Banana		Price on request
5	Tomato		1,159
6	Potato		125
Sheet1

After

supernerd81.xlsm
	A	B	C	D	E	F
1		Old Price	Old Price
2	Apple	2,370	2,250		increase prices by	1.05
3	Pear	3,420	3,250
4	Banana	Price on request	Price on request
5	Tomato	1,220	1,159
6	Potato	140	125
Sheet1

 

[Supernerd81]

I just realised that it's your separators that's confusing me (Doh!). Try this instead

Option Explicit
Sub Supernerd81()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Dim x As Double
    x = ws.Range("F2").Value
  
    With ws.Range("B2:B" & Cells(Rows.Count, "C").End(xlUp).Row)
        .Value = Evaluate("IF(isnumber(" & .Offset(0, 1).Address & "),Roundup(" & .Offset(0, 1).Address & "*" & x & ",-1)," & .Offset(0, 1).Address & ")")
    End With
End Sub

Before

supernerd81.xlsm
	A	B	C	D	E	F
1		Old Price	Old Price
2	Apple		2,250		increase prices by	1.05
3	Pear		3,250
4	Banana		Price on request
5	Tomato		1,159
6	Potato		125
Sheet1

After

supernerd81.xlsm
	A	B	C	D	E	F
1		Old Price	Old Price
2	Apple	2,370	2,250		increase prices by	1.05
3	Pear	3,420	3,250
4	Banana	Price on request	Price on request
5	Tomato	1,220	1,159
6	Potato	140	125
Sheet1

It's nice to have alternatives.
That one gives me #VALUE in all cells and I am not sure why.

 

[kevin9999]

As you can see from post #6 it does work for me on the small data set I used to test it. I would really need to get your actual worksheet to see what the problem is, but whether it's worth your trouble, given that you already have a working solution from @Flashbond is up to you. You could provide a sample of your worksheet using the XL2BB add in, or alternatively share your file via Dropbox, Google Drive or similar file sharing platform.

 

[Supernerd81]

Oh my bad.. I am glad you have managed. Thanks for the feedback

I am back with one more request!
I would like to skip certain rows. I can make the values a different text colour or I can fill the cells with a different colour. I have tried putting it in your macro but I'm having difficulty. It says 'object required'.

Sub test()
  Dim oldPrices As Variant, newPrices As Variant, increaseRatio As Double
  With Application
  oldPrices = .Transpose(Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row))
  ReDim newPrices(1 To UBound(oldPrices), 1 To 1)
  increaseRatio = Range("F2").Value2
 
  For i = 1 To UBound(oldPrices)
    If IsNumeric(oldPrices(i)) And Interior.Color(oldPrices(i)) = RGB(255, 0, 0) Then
      newPrices(i, 1) = .WorksheetFunction.RoundUp(oldPrices(i) * increaseRatio, -1)
    Else
       newPrices(i, 1) = oldPrices(i)
    End If
  Next
  End With
 
  Range("B2").Resize(UBound(newPrices)) = newPrices
End Sub

I have tried adding "Interior.Color(oldPrices(i)) = RGB(255, 0, 0)" which should only select the red cells, but as I said this requires an object! (And "oldPrices(i)" is not the object apparently.)

 

[Legacy 143009]

These are just arrays. They only store values. They are not range or actual cell referances. You can't format them.

However, you can define rule for skipping. What would be the rule?
If I were you I would go for conditional formatting for the color. What will be the coloring rule?