excelvba

FIFO VBA of GPT


Orders Orders

PickList PickList

Stock Live Stock

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


Solution

  • 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