# Auto Round Pack Sizes

##### Well-known Member
Hello All,

I have an order form the Worksheet is named 'Stock Orders' Column A contains part codes Column B is for qty's required.

On another worksheet named 'Pack Sizes' column A has part codes and Coulmn B contains pack sizes, i.e. part AI56 comes in packs of 10.

Is there away in VBA where if someone places an order for AI56 qty 6 the cell automatically will round to 10.

If anybody has a link, or any advice that would be much appreciated.

### Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

#### wavemehello

##### Well-known Member
hello wavemehello, i had thought about that but it would mean reformating the order page which we do not want to do

#### erik.van.geit

##### MrExcel MVP
Hi,

but CEILING is the key to proceed

starting with this idea
A    B        C
1 CODE Quantity
2 A6   11       12
3 A4   18       21
4 A2   40       40
5 A3   4        6
6 A5   6        10

Stock Orders

[Table-It] version 06 by Erik Van Geit
Code:
``````RANGE FORMULA (1st cell)
C2:C6 =CEILING(B2,LOOKUP(A2,'Pack Sizes'!\$A\$2:\$A\$6,'Pack Sizes'!\$B\$2:\$B\$6))

[Table-It] version 06 by Erik Van Geit``````

refering to
A    B
1 CODE pack
2 A2   5
3 A3   3
4 A4   7
5 A5   10
6 A6   12

Pack Sizes

[Table-It] version 06 by Erik Van Geit

record a macro filling in the correct formula in column C
Code:
``````    ActiveCell.FormulaR1C1 = _
"=CEILING(RC[-1],LOOKUP(RC[-2],'Pack Sizes'!R2C1:R6C1,'Pack Sizes'!R2C2:R6C2))"``````

then edit
Code:
``````    With Target
.Formula = "=CEILING(" & .Address & ",LOOKUP(" & .Offset(0, -1).Address & _
",'Pack Sizes'!A2:A6,'Pack Sizes'!B2:B6))"
End With``````
also added a check in case one of the changed cells is empty
=IF(A2="";""; ...)

now let's insert (and delete at the end) a column to put the formulas and copy the results to the targetcolumn...
full code in worksheetmodule
Code:
``````Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim changeRng As Range

Set changeRng = Intersect(Target, Range("B2:B" & Rows.Count))

If changeRng Is Nothing Then Exit Sub

If changeRng.Areas.Count > 1 Then
MsgBox "Please change only 1 area at a time", 48, "ERROR"
Application.Undo
Exit Sub
End If

Application.ScreenUpdating = False
Application.EnableEvents = False

With changeRng
Columns(.Column + 1).Insert
.Offset(0, 1).Formula = _
"=IF(" & .Cells(1).Address(0, 0) & "="""","""",CEILING(" & .Cells(1).Address(0, 0) & ",LOOKUP(" & .Cells(1).Offset(0, -1).Address(0, 0) & _
",'Pack Sizes'!\$A\$2:\$A\$6,'Pack Sizes'!\$B\$2:\$B\$6)))"
.Value = .Offset(0, 1).Value
Columns(.Column + 1).Delete
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub``````
kind regards,
Erik

#### erik.van.geit

##### MrExcel MVP

name of "pack sizes" can be edited on top
last row in "pack sizes" is dynamic

in the same way you could edit the colum labels ...

Code:
``````Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim changeRng As Range
Dim LR As Long

Const checkSH = "Pack Sizes"
LR = Worksheets(checkSH).Cells(Rows.Count, 1).End(xlUp).Row
Set changeRng = Intersect(Target, Range("B2:B" & Rows.Count))

If changeRng Is Nothing Then Exit Sub

If changeRng.Areas.Count > 1 Then
MsgBox "Please change only area at a time", 48, "ERROR"
Application.Undo
Exit Sub
End If

Application.ScreenUpdating = False
Application.EnableEvents = False

With changeRng
Columns(.Column + 1).Insert
.Offset(0, 1).Formula = _
"=IF(" & .Cells(1).Address(0, 0) & "="""","""",CEILING(" & .Cells(1).Address(0, 0) & ",LOOKUP(" & .Cells(1).Offset(0, -1).Address(0, 0) & _
",'" & checkSH & "'!\$A\$2:\$A\$" & LR & ",'" & checkSH & "'!\$B\$2:\$B\$" & LR & ")))"
.Value = .Offset(0, 1).Value
Columns(.Column + 1).Delete
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub``````

##### Well-known Member
thanks once again erik,

#### erik.van.geit

##### MrExcel MVP
you're WELCOME again

is that you, the avatar ?

#### erik.van.geit

##### MrExcel MVP
you're WELCOME again

is that you, the avatar ?

Replies
6
Views
123
Replies
12
Views
969
Replies
0
Views
86
Replies
3
Views
208
Replies
5
Views
522

1,136,508
Messages
5,676,270
Members
419,617
Latest member
Shane50GT

### 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.

### Which adblocker are you using?

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

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