Purchase Order Generator

' Purchase Order Generator
' Suppliers sheet: SupplierID (A), Name (B), Address (C), Contact (D), Email (E), Terms (F)
' PO sheet: Purchase order form layout
' PO Log sheet: Historical record of all POs

Sub CreatePurchaseOrder()
    ' Generate a new purchase order
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim wsPO As Worksheet
    Dim wsSuppliers As Worksheet
    Dim wsLog As Worksheet

    Set wsPO = ThisWorkbook.Sheets("Purchase Order")

    On Error Resume Next
    Set wsSuppliers = ThisWorkbook.Sheets("Suppliers")
    Set wsLog = ThisWorkbook.Sheets("PO Log")
    On Error GoTo ErrorHandler

    If wsSuppliers Is Nothing Then
        MsgBox "Please create a 'Suppliers' sheet with columns: SupplierID, Name, Address, Contact, Email, Terms", vbExclamation
        Exit Sub
    End If

    ' Create PO Log if it doesn't exist
    If wsLog Is Nothing Then
        Set wsLog = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsLog.Name = "PO Log"
        wsLog.Cells(1, 1).Value = "PO Number"
        wsLog.Cells(1, 2).Value = "Date"
        wsLog.Cells(1, 3).Value = "Supplier"
        wsLog.Cells(1, 4).Value = "Total"
        wsLog.Cells(1, 5).Value = "Status"
        wsLog.Cells(1, 6).Value = "Approved By"

        With wsLog.Range("A1:F1")
            .Font.Bold = True
            .Interior.Color = RGB(0, 102, 204)
            .Font.Color = RGB(255, 255, 255)
        End With
    End If

    ' Clear previous PO
    wsPO.Range("A8:F50").ClearContents
    wsPO.Range("A8:F50").ClearFormats

    ' Generate PO number
    Dim poNumber As String
    Dim lastPONum As Long
    Dim lastLogRow As Long
    lastLogRow = wsLog.Cells(wsLog.Rows.Count, "A").End(xlUp).Row

    If lastLogRow > 1 Then
        ' Extract number from last PO
        Dim lastPO As String
        lastPO = wsLog.Cells(lastLogRow, 1).Value
        lastPONum = Val(Replace(lastPO, "PO-", ""))
    End If

    lastPONum = lastPONum + 1
    poNumber = "PO-" & Format(lastPONum, "0000")

    ' PO Header
    wsPO.Range("A1").Value = "PURCHASE ORDER"
    wsPO.Range("A1").Font.Size = 20
    wsPO.Range("A1").Font.Bold = True
    wsPO.Range("A1").Font.Color = RGB(0, 102, 204)

    wsPO.Range("D1").Value = "PO Number:"
    wsPO.Range("E1").Value = poNumber
    wsPO.Range("E1").Font.Bold = True

    wsPO.Range("D2").Value = "Date:"
    wsPO.Range("E2").Value = Format(Date, "dd/mm/yyyy")

    wsPO.Range("D3").Value = "Required By:"
    Dim requiredDate As String
    requiredDate = InputBox("Enter required delivery date (dd/mm/yyyy):", "Delivery Date", Format(DateAdd("d", 14, Date), "dd/mm/yyyy"))
    If requiredDate = "" Then requiredDate = Format(DateAdd("d", 14, Date), "dd/mm/yyyy")
    wsPO.Range("E3").Value = requiredDate

    ' Select supplier
    Dim supplierName As String
    supplierName = InputBox("Enter supplier name:", "Supplier")
    If supplierName = "" Then Exit Sub

    ' Look up supplier
    Dim lastSupRow As Long
    lastSupRow = wsSuppliers.Cells(wsSuppliers.Rows.Count, "A").End(xlUp).Row

    Dim supplierFound As Boolean
    Dim supplierRow As Long

    Dim i As Long
    For i = 2 To lastSupRow
        If LCase(wsSuppliers.Cells(i, 2).Value) = LCase(supplierName) Then
            supplierFound = True
            supplierRow = i
            Exit For
        End If
    Next i

    ' Write supplier details
    wsPO.Range("A3").Value = "Supplier:"
    wsPO.Range("A3").Font.Bold = True

    If supplierFound Then
        wsPO.Range("A4").Value = wsSuppliers.Cells(supplierRow, 2).Value
        wsPO.Range("A5").Value = wsSuppliers.Cells(supplierRow, 3).Value
        wsPO.Range("A6").Value = "Contact: " & wsSuppliers.Cells(supplierRow, 4).Value
    Else
        wsPO.Range("A4").Value = supplierName
        wsPO.Range("A5").Value = "(Supplier not in database)"
    End If

    ' Line item headers
    Dim headerRow As Long
    headerRow = 8

    wsPO.Cells(headerRow, 1).Value = "Item #"
    wsPO.Cells(headerRow, 2).Value = "Description"
    wsPO.Cells(headerRow, 3).Value = "Quantity"
    wsPO.Cells(headerRow, 4).Value = "Unit"
    wsPO.Cells(headerRow, 5).Value = "Unit Price"
    wsPO.Cells(headerRow, 6).Value = "Line Total"

    With wsPO.Range("A" & headerRow & ":F" & headerRow)
        .Font.Bold = True
        .Interior.Color = RGB(0, 102, 204)
        .Font.Color = RGB(255, 255, 255)
    End With

    ' Enter line items
    Dim itemRow As Long
    itemRow = headerRow + 1
    Dim subtotal As Double
    Dim itemNum As Long

    Do
        Dim itemDesc As String
        itemDesc = InputBox("Enter item description (leave blank to finish):", "Item " & (itemRow - headerRow))
        If itemDesc = "" Then Exit Do

        Dim itemQty As Double
        itemQty = Val(InputBox("Enter quantity:", "Quantity", "1"))

        Dim itemUnit As String
        itemUnit = InputBox("Enter unit (each, box, kg, etc.):", "Unit", "each")

        Dim itemPrice As Double
        itemPrice = Val(InputBox("Enter unit price:", "Unit Price"))

        itemNum = itemNum + 1
        wsPO.Cells(itemRow, 1).Value = itemNum
        wsPO.Cells(itemRow, 1).HorizontalAlignment = xlCenter
        wsPO.Cells(itemRow, 2).Value = itemDesc
        wsPO.Cells(itemRow, 3).Value = itemQty
        wsPO.Cells(itemRow, 3).HorizontalAlignment = xlCenter
        wsPO.Cells(itemRow, 4).Value = itemUnit
        wsPO.Cells(itemRow, 4).HorizontalAlignment = xlCenter
        wsPO.Cells(itemRow, 5).Value = itemPrice
        wsPO.Cells(itemRow, 5).NumberFormat = "#,##0.00"
        wsPO.Cells(itemRow, 6).Value = itemQty * itemPrice
        wsPO.Cells(itemRow, 6).NumberFormat = "#,##0.00"

        subtotal = subtotal + (itemQty * itemPrice)
        itemRow = itemRow + 1
    Loop

    ' Totals
    Dim totalsRow As Long
    totalsRow = itemRow + 1

    Dim vatRate As Double
    vatRate = 0.2

    wsPO.Cells(totalsRow, 5).Value = "Subtotal:"
    wsPO.Cells(totalsRow, 5).Font.Bold = True
    wsPO.Cells(totalsRow, 6).Value = subtotal
    wsPO.Cells(totalsRow, 6).NumberFormat = "#,##0.00"

    wsPO.Cells(totalsRow + 1, 5).Value = "VAT (20%):"
    wsPO.Cells(totalsRow + 1, 5).Font.Bold = True
    wsPO.Cells(totalsRow + 1, 6).Value = subtotal * vatRate
    wsPO.Cells(totalsRow + 1, 6).NumberFormat = "#,##0.00"

    Dim grandTotal As Double
    grandTotal = subtotal + (subtotal * vatRate)

    wsPO.Cells(totalsRow + 2, 5).Value = "TOTAL:"
    wsPO.Cells(totalsRow + 2, 5).Font.Bold = True
    wsPO.Cells(totalsRow + 2, 5).Font.Size = 13
    wsPO.Cells(totalsRow + 2, 6).Value = grandTotal
    wsPO.Cells(totalsRow + 2, 6).NumberFormat = "#,##0.00"
    wsPO.Cells(totalsRow + 2, 6).Font.Bold = True
    wsPO.Cells(totalsRow + 2, 6).Font.Size = 13

    ' Terms and conditions
    wsPO.Cells(totalsRow + 4, 1).Value = "Terms & Conditions:"
    wsPO.Cells(totalsRow + 4, 1).Font.Bold = True

    If supplierFound Then
        wsPO.Cells(totalsRow + 5, 1).Value = "Payment Terms: " & wsSuppliers.Cells(supplierRow, 6).Value
    Else
        wsPO.Cells(totalsRow + 5, 1).Value = "Payment Terms: Net 30 days"
    End If

    wsPO.Cells(totalsRow + 7, 1).Value = "Authorised By: ___________________________"
    wsPO.Cells(totalsRow + 8, 1).Value = "Date: ___________________________"

    ' Log the PO
    lastLogRow = wsLog.Cells(wsLog.Rows.Count, "A").End(xlUp).Row + 1
    wsLog.Cells(lastLogRow, 1).Value = poNumber
    wsLog.Cells(lastLogRow, 2).Value = Format(Date, "dd/mm/yyyy")
    wsLog.Cells(lastLogRow, 3).Value = supplierName
    wsLog.Cells(lastLogRow, 4).Value = grandTotal
    wsLog.Cells(lastLogRow, 4).NumberFormat = "#,##0.00"
    wsLog.Cells(lastLogRow, 5).Value = "Pending"

    ' Auto-fit
    wsPO.Columns("A:F").AutoFit
    wsPO.Columns("B").ColumnWidth = 35

    Application.ScreenUpdating = True

    MsgBox "Purchase Order " & poNumber & " created!" & vbCrLf & _
           "Total: " & Format(grandTotal, "#,##0.00"), vbInformation

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "Error creating PO: " & Err.Description, vbCritical
End Sub