Auto Round Pack Sizes

[Paddy1979]

Hello All,

Please can you help?

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.

 

[wavemehello]

how about using ceiling function?

 

[Paddy1979]

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]

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

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

    ActiveCell.FormulaR1C1 = _
        "=CEILING(RC[-1],LOOKUP(RC[-2],'Pack Sizes'!R2C1:R6C1,'Pack Sizes'!R2C2:R6C2))"

then edit

    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

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]

added some flexibility
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 ...

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

 

[Paddy1979]

thanks once again erik,

 

[erik.van.geit]

you're WELCOME again

is that you, the avatar ?

 

[erik.van.geit]

you're WELCOME again

is that you, the avatar ?