Code is
Sub CreatePickListWithoutEditingStock()
Dim wsOrders As Worksheet
Dim wsLiveStock As Worksheet
Dim wsPickList As Worksheet
Dim orderRow As Long
Dim stockRow As Long
Dim pickRow As Long
Dim qtyToPick As Long
Dim qtyPicked As Long
Dim pickListNumber As Long
Dim lastOrderRow As Long
Dim lastStockRow As Long
Dim stockQty As Long
Dim dateOrdered As Date
Dim orderNumber As String
Dim itemCode As String
Dim itemName As String
' Sheets ko set karna
Set wsOrders = ThisWorkbook.Sheets("Orders")
Set wsLiveStock = ThisWorkbook.Sheets("Live Stock")
Set wsPickList = ThisWorkbook.Sheets("PickList")
' Orders sheet mein last row dhoondhna
lastOrderRow = wsOrders.Cells(wsOrders.Rows.Count, 1).End(xlUp).Row
' Pick list number initialize karna
pickListNumber = 1
' Har order ke liye loop karna
For orderRow = 2 To lastOrderRow
dateOrdered = wsOrders.Cells(orderRow, 1).Value
orderNumber = wsOrders.Cells(orderRow, 2).Value
itemCode = wsOrders.Cells(orderRow, 3).Value
itemName = wsOrders.Cells(orderRow, 4).Value
qtyToPick = wsOrders.Cells(orderRow, 5).Value
' Live Stock sheet mein last row dhoondhna
lastStockRow = wsLiveStock.Cells(wsLiveStock.Rows.Count, 1).End(xlUp).Row
' Live Stock sheet mein items ko FIFO ke adhar par pick karna bina qty ko update kiye
For stockRow = 2 To lastStockRow
If wsLiveStock.Cells(stockRow, 1).Value = itemCode Then
stockQty = wsLiveStock.Cells(stockRow, 5).Value
If stockQty > 0 Then
If qtyToPick <= stockQty Then
qtyPicked = qtyToPick
Else
qtyPicked = stockQty
End If
' PickList sheet mein entry add karna
pickRow = wsPickList.Cells(wsPickList.Rows.Count, 1).End(xlUp).Row + 1
wsPickList.Cells(pickRow, 1).Value = dateOrdered
wsPickList.Cells(pickRow, 2).Value = pickListNumber
wsPickList.Cells(pickRow, 3).Value = itemCode
wsPickList.Cells(pickRow, 4).Value = itemName
wsPickList.Cells(pickRow, 5).Value = wsLiveStock.Cells(stockRow, 3).Value ' Best Before Date
wsPickList.Cells(pickRow, 6).Value = wsLiveStock.Cells(stockRow, 4).Value ' Storage Location
wsPickList.Cells(pickRow, 7).Value = qtyPicked
wsPickList.Cells(pickRow, 8).Value = wsLiveStock.Cells(stockRow, 6).Value ' Remaining Shelf Life
qtyToPick = qtyToPick - qtyPicked
If qtyToPick <= 0 Then Exit For
End If
End If
Next stockRow
' Agar quantity abhi bhi baaki hai to error message dikhana
If qtyToPick > 0 Then
MsgBox "Order number " & orderNumber & " ke liye item code " & itemCode & " ka required quantity fulfill nahi ho paa raha hai.", vbExclamation
End If
' Next order ke liye pick list number increment karna
pickListNumber = pickListNumber + 1
Next orderRow
MsgBox "Pick List created successfully!", vbInformation
End Sub
Qty of picklist is not being picked up completely
I can't reproduce your results and this is the test data I used. Run the setup macro in a blank workbook with 3 sheets and add your code.
Option Explicit
Sub SetUp()
' Live Stock
With Sheet1
.Name = "Live Stock"
.Range("A2:E2") = Array(10001, "ATTA 25 KG", "2025/01/24", "R-03", 5)
.Range("A3:E3") = Array(10001, "ATTA 25 KG", "2025/01/25", "R-02", 10)
.Range("A4:E4") = Array(10002, "BASMATI RICE 25 KG", "2025/01/01", "R-04", 55)
.Range("A5:E5") = Array(10002, "BASMATI RICE 25 KG", "2025/04/02", "R-03", 55)
.Range("A6:E6") = Array(10005, "ATTA 10 KG", "2025/01/01", "R-05", 60)
.Range("A7:E7") = Array(10005, "ATTA 10 KG", "2025/04/02", "R-06", 1)
.Range("F2:F7").FormulaR1C1 = "=RC[-3] - TODAY()"
.Columns(3).NumberFormat = "dd-mm-yyy"
.Columns(6).NumberFormat = "0"
End With
' Orders
With Sheet2
.Name = "Orders"
.Range("A2:E2") = Array("2025/01/25", 50002, 10001, "ATTA 25 KG", 13)
.Range("A3:E3") = Array("2025/01/25", 50002, 10002, "BASMATI RICE 25 KG", 60)
.Range("A4:E4") = Array("2025/01/25", 50002, 10005, "ATTA 10 KG", 61)
.Columns(1).NumberFormat = "dd-mm-yyyy"
.Columns(5).NumberFormat = "0"
End With
Sheet3.Name = "PickList"
End Sub