Sub Create_Pick_List()
'
' Create_Pick_List Macro
' Create pick list from POS generated order
'
' Keyboard Shortcut: Ctrl+e
'
Cells.Select
Selection.RowHeight = 15
Selection.ColumnWidth = 8.43
Rows("1:6").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.FormulaR1C1 = "Check"
Columns("F:F").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("C1").Select
ActiveCell.FormulaR1C1 = "Ordered"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Pulled"
Columns("E:E").Select
ActiveWindow.View = xlPageLayoutView
Columns("A:A").EntireColumn.AutoFit
Selection.ColumnWidth = 58
Range("A1:E10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Dim myrange As String
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveSheet.Cells(3, 2).Select
myrange = Cells(Rows.Count, 5).End(xlUp).Address
ActiveSheet.PageSetup.PrintArea = "$A$1:" & myrange
Dim Rws As Long, Col As Integer, r As Range, fRng As Range
Set r = Range("A1")
Rws = Cells.Find(what:="*", After:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Col = Cells.Find(what:="*", After:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set fRng = Range(Cells(1, 1), Cells(Rws, Col)) ' range A4 to last cell on sheet
fRng.Select 'or whatever you want to do with the range
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' inserts the same header/footer in all worksheets
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Application.StatusBar = "Changing header/footer in " & ws.Name
With ActiveSheet.PageSetup
.TopMargin = Application.InchesToPoints(1.25)
.LeftHeader = "&D"
.CenterHeader = "&B& &18& Pepper Palace"
.RightHeader = "Ship *" & Chr$(13) & "Carrier *" & Chr$(13) & "Pallets *" & Chr$(13) & "Napalm *"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P"
End With
Next ws
Set ws = Nothing
Application.StatusBar = False
End Sub
Sub test()
Dim c As Range, d As Range, multiple As Long
For Each c In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
Select Case UCase(c)
Case "H48": multiple = 12
Case "N3125": multiple = 10
Case Else: multiple = 1
End Select
Set d = c.Offset(, 1)
If IsNumeric(d) And d <> "" Then d = -Int(-d / multiple) * multiple
Next
End Sub
