Inventory Management System

' Inventory Management System
' Main sheet (Inventory): Product Code (A), Name (B), Category (C),
'   Location (D), Qty in Stock (E), Reorder Level (F), Unit Cost (G),
'   Stock Value (H), Status (I)
' Movements sheet: Date (A), Product Code (B), Type (C), Quantity (D),
'   Reference (E), Notes (F)

Sub UpdateStockLevels()
    ' Recalculate stock values and check reorder levels
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim wsInv As Worksheet
    Set wsInv = ThisWorkbook.Sheets("Inventory")

    Dim lastRow As Long
    lastRow = wsInv.Cells(wsInv.Rows.Count, "A").End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "No inventory data found.", vbExclamation
        Exit Sub
    End If

    Dim lowStockItems As String
    Dim outOfStockItems As String
    Dim lowCount As Long
    Dim outCount As Long

    Dim i As Long
    For i = 2 To lastRow
        Dim qty As Double
        Dim reorderLevel As Double
        Dim unitCost As Double

        qty = Val(wsInv.Cells(i, 5).Value)
        reorderLevel = Val(wsInv.Cells(i, 6).Value)
        unitCost = Val(wsInv.Cells(i, 7).Value)

        ' Calculate stock value
        wsInv.Cells(i, 8).Value = qty * unitCost
        wsInv.Cells(i, 8).NumberFormat = "#,##0.00"

        ' Determine status
        Dim status As String
        If qty <= 0 Then
            status = "Out of Stock"
            outOfStockItems = outOfStockItems & wsInv.Cells(i, 2).Value & vbCrLf
            outCount = outCount + 1
            wsInv.Cells(i, 9).Interior.Color = RGB(255, 150, 150)
        ElseIf qty <= reorderLevel Then
            status = "Low Stock"
            lowStockItems = lowStockItems & wsInv.Cells(i, 2).Value & _
                " (Qty: " & qty & ", Reorder at: " & reorderLevel & ")" & vbCrLf
            lowCount = lowCount + 1
            wsInv.Cells(i, 9).Interior.Color = RGB(255, 230, 150)
        ElseIf qty <= reorderLevel * 1.5 Then
            status = "Adequate"
            wsInv.Cells(i, 9).Interior.Color = RGB(200, 230, 255)
        Else
            status = "In Stock"
            wsInv.Cells(i, 9).Interior.Color = RGB(200, 240, 200)
        End If

        wsInv.Cells(i, 9).Value = status
    Next i

    ' Format currency column
    wsInv.Range("G2:H" & lastRow).NumberFormat = "#,##0.00"
    wsInv.Columns("A:I").AutoFit

    Application.ScreenUpdating = True

    ' Show alerts
    Dim alertMsg As String
    If outCount > 0 Then
        alertMsg = "OUT OF STOCK (" & outCount & " items):" & vbCrLf & outOfStockItems & vbCrLf
    End If
    If lowCount > 0 Then
        alertMsg = alertMsg & "LOW STOCK (" & lowCount & " items):" & vbCrLf & lowStockItems
    End If

    If alertMsg <> "" Then
        MsgBox alertMsg, vbExclamation, "Stock Alerts"
    Else
        MsgBox "All stock levels are healthy.", vbInformation
    End If

    Exit Sub

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

Sub RecordStockMovement()
    ' Record incoming or outgoing stock
    On Error GoTo ErrorHandler

    Dim wsInv As Worksheet
    Dim wsMov As Worksheet

    Set wsInv = ThisWorkbook.Sheets("Inventory")

    On Error Resume Next
    Set wsMov = ThisWorkbook.Sheets("Movements")
    On Error GoTo ErrorHandler

    If wsMov Is Nothing Then
        Set wsMov = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsMov.Name = "Movements"
        wsMov.Cells(1, 1).Value = "Date"
        wsMov.Cells(1, 2).Value = "Product Code"
        wsMov.Cells(1, 3).Value = "Type"
        wsMov.Cells(1, 4).Value = "Quantity"
        wsMov.Cells(1, 5).Value = "Reference"
        wsMov.Cells(1, 6).Value = "Notes"

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

    ' Get movement details
    Dim productCode As String
    productCode = InputBox("Enter product code:", "Stock Movement")
    If productCode = "" Then Exit Sub

    ' Find product in inventory
    Dim lastInvRow As Long
    lastInvRow = wsInv.Cells(wsInv.Rows.Count, "A").End(xlUp).Row

    Dim productRow As Long
    productRow = 0

    Dim i As Long
    For i = 2 To lastInvRow
        If UCase(wsInv.Cells(i, 1).Value) = UCase(productCode) Then
            productRow = i
            Exit For
        End If
    Next i

    If productRow = 0 Then
        MsgBox "Product code '" & productCode & "' not found in inventory.", vbExclamation
        Exit Sub
    End If

    Dim productName As String
    productName = wsInv.Cells(productRow, 2).Value
    Dim currentQty As Double
    currentQty = Val(wsInv.Cells(productRow, 5).Value)

    ' Get movement type
    Dim movType As String
    Dim response As VbMsgBoxResult
    response = MsgBox("Product: " & productName & " (Current stock: " & currentQty & ")" & vbCrLf & vbCrLf & _
                     "Yes = Stock IN (receiving)" & vbCrLf & _
                     "No = Stock OUT (dispatching)", vbYesNoCancel + vbQuestion, "Movement Type")

    If response = vbCancel Then Exit Sub
    movType = IIf(response = vbYes, "IN", "OUT")

    ' Get quantity
    Dim movQty As Double
    movQty = Val(InputBox("Enter quantity to " & IIf(movType = "IN", "receive", "dispatch") & ":", "Quantity"))
    If movQty <= 0 Then
        MsgBox "Invalid quantity.", vbExclamation
        Exit Sub
    End If

    ' Check if enough stock for OUT
    If movType = "OUT" And movQty > currentQty Then
        MsgBox "Insufficient stock. Current quantity: " & currentQty, vbExclamation
        Exit Sub
    End If

    ' Get reference
    Dim reference As String
    reference = InputBox("Enter reference (PO number, order number, etc.):", "Reference", "")

    ' Record movement
    Dim lastMovRow As Long
    lastMovRow = wsMov.Cells(wsMov.Rows.Count, "A").End(xlUp).Row + 1

    wsMov.Cells(lastMovRow, 1).Value = Now
    wsMov.Cells(lastMovRow, 1).NumberFormat = "dd/mm/yyyy hh:mm"
    wsMov.Cells(lastMovRow, 2).Value = productCode
    wsMov.Cells(lastMovRow, 3).Value = movType
    wsMov.Cells(lastMovRow, 4).Value = movQty
    wsMov.Cells(lastMovRow, 5).Value = reference

    ' Update inventory
    If movType = "IN" Then
        wsInv.Cells(productRow, 5).Value = currentQty + movQty
    Else
        wsInv.Cells(productRow, 5).Value = currentQty - movQty
    End If

    ' Refresh stock levels
    Call UpdateStockLevels

    MsgBox movType & ": " & movQty & " x " & productName & vbCrLf & _
           "New stock level: " & wsInv.Cells(productRow, 5).Value, vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "Error recording movement: " & Err.Description, vbCritical
End Sub

Sub GenerateStockValuationReport()
    ' Create stock valuation summary by category
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim wsInv As Worksheet
    Set wsInv = ThisWorkbook.Sheets("Inventory")

    Dim lastRow As Long
    lastRow = wsInv.Cells(wsInv.Rows.Count, "A").End(xlUp).Row

    ' Collect categories
    Dim categories As Object
    Set categories = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 2 To lastRow
        Dim cat As String
        cat = wsInv.Cells(i, 3).Value
        If cat = "" Then cat = "Uncategorised"

        If Not categories.Exists(cat) Then
            categories.Add cat, Array(0, 0, 0) ' items, totalQty, totalValue
        End If

        Dim vals As Variant
        vals = categories(cat)
        vals(0) = vals(0) + 1
        vals(1) = vals(1) + Val(wsInv.Cells(i, 5).Value)
        vals(2) = vals(2) + Val(wsInv.Cells(i, 8).Value)
        categories(cat) = vals
    Next i

    ' Create report sheet
    Dim wsReport As Worksheet
    On Error Resume Next
    Set wsReport = ThisWorkbook.Sheets("Stock Valuation")
    On Error GoTo ErrorHandler

    If wsReport Is Nothing Then
        Set wsReport = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsReport.Name = "Stock Valuation"
    Else
        wsReport.Cells.Clear
    End If

    ' Title
    wsReport.Cells(1, 1).Value = "Stock Valuation Report"
    wsReport.Cells(1, 1).Font.Size = 16
    wsReport.Cells(1, 1).Font.Bold = True
    wsReport.Cells(2, 1).Value = "Generated: " & Format(Now, "dd/mm/yyyy hh:mm")

    ' Headers
    wsReport.Cells(4, 1).Value = "Category"
    wsReport.Cells(4, 2).Value = "Items"
    wsReport.Cells(4, 3).Value = "Total Quantity"
    wsReport.Cells(4, 4).Value = "Total Value"

    With wsReport.Range("A4:D4")
        .Font.Bold = True
        .Interior.Color = RGB(0, 102, 204)
        .Font.Color = RGB(255, 255, 255)
    End With

    ' Write data
    Dim row As Long
    row = 5
    Dim grandTotal As Double

    Dim key As Variant
    For Each key In categories.Keys
        vals = categories(key)
        wsReport.Cells(row, 1).Value = key
        wsReport.Cells(row, 2).Value = vals(0)
        wsReport.Cells(row, 3).Value = vals(1)
        wsReport.Cells(row, 4).Value = vals(2)
        wsReport.Cells(row, 4).NumberFormat = "#,##0.00"
        grandTotal = grandTotal + vals(2)
        row = row + 1
    Next key

    ' Grand total
    wsReport.Cells(row + 1, 3).Value = "Grand Total:"
    wsReport.Cells(row + 1, 3).Font.Bold = True
    wsReport.Cells(row + 1, 4).Value = grandTotal
    wsReport.Cells(row + 1, 4).NumberFormat = "#,##0.00"
    wsReport.Cells(row + 1, 4).Font.Bold = True

    wsReport.Columns("A:D").AutoFit

    Application.ScreenUpdating = True

    MsgBox "Stock valuation report generated!", vbInformation

    Exit Sub

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