Case Management System

Complete ticket/case management system with assignment, tracking, timestamps, and team member workload distribution.

500 views

Perfect For:

  • IT helpdesk ticketing
  • Customer support cases
  • Task assignment
  • Work queue management
  • Service request tracking
VBA Code
' Case Management System
' Sheet structure: CaseID (A), Status (B), AllocatedTo (C), Picked (D), Comment (E),
' ActionTaken (F), PickedTime (G), ActionTime (H), DroppedTime (I)

' Global variable to store active case per user
Public activeCaseID As String
Public activeUser As String

Sub GetWork()
    ' Assign next available case to team member
    On Error GoTo ErrorHandler

    ' Prompt for team member name
    Dim userName As String
    userName = InputBox("Enter your name:", "Get Work")

    If userName = "" Then Exit Sub

    ' Check if user has an active case
    If activeUser = userName And activeCaseID <> "" Then
        MsgBox "You must submit your current case (ID: " & activeCaseID & ") before getting a new one.", vbExclamation
        Exit Sub
    End If

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Dump")

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

    ' Find first unassigned case for this user
    Dim i As Long
    Dim foundCase As Boolean
    foundCase = False

    For i = 2 To lastRow
        If ws.Cells(i, 3).Value = userName And ws.Cells(i, 4).Value = "" Then
            ' Found available case
            Dim caseID As String
            Dim caseStatus As String

            caseID = ws.Cells(i, 1).Value
            caseStatus = ws.Cells(i, 2).Value

            ' Mark as picked
            ws.Cells(i, 4).Value = "Y"
            ws.Cells(i, 7).Value = Now ' PickedTime

            ' Store active case
            activeCaseID = caseID
            activeUser = userName

            ' Show case details
            MsgBox "Case assigned!" & vbCrLf & vbCrLf & _
                   "Case ID: " & caseID & vbCrLf & _
                   "Status: " & caseStatus, vbInformation

            foundCase = True
            Exit For
        End If
    Next i

    If Not foundCase Then
        MsgBox "No available cases assigned to " & userName & ".", vbInformation
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error getting work: " & Err.Description, vbCritical
End Sub

Sub SubmitCase()
    ' Submit completed case with action details
    On Error GoTo ErrorHandler

    ' Check if user has an active case
    If activeCaseID = "" Then
        MsgBox "You don't have an active case to submit.", vbExclamation
        Exit Sub
    End If

    ' Prompt for comment and action taken
    Dim userComment As String
    Dim actionTaken As String

    userComment = InputBox("Enter your comment:", "Submit Case - Comment")
    If userComment = "" Then
        MsgBox "Comment is required.", vbExclamation
        Exit Sub
    End If

    actionTaken = InputBox("Enter action taken:", "Submit Case - Action")
    If actionTaken = "" Then
        MsgBox "Action taken is required.", vbExclamation
        Exit Sub
    End If

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Dump")

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

    ' Find the active case row
    Dim i As Long
    For i = 2 To lastRow
        If ws.Cells(i, 1).Value = activeCaseID Then
            ' Update case details
            ws.Cells(i, 5).Value = userComment ' Comment
            ws.Cells(i, 6).Value = actionTaken ' ActionTaken
            ws.Cells(i, 8).Value = Now ' ActionTime
            ws.Cells(i, 9).Value = Now ' DroppedTime

            ' Optional: Copy to team member's history sheet
            Call CopyToTeamSheet(activeUser, i)

            MsgBox "Case " & activeCaseID & " submitted successfully!", vbInformation

            ' Clear active case
            activeCaseID = ""
            activeUser = ""

            Exit For
        End If
    Next i

    Exit Sub

ErrorHandler:
    MsgBox "Error submitting case: " & Err.Description, vbCritical
End Sub

Sub CopyToTeamSheet(userName As String, sourceRow As Long)
    ' Copy completed case to team member's history sheet
    On Error Resume Next

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Dump")

    ' Create team sheet if doesn't exist
    Dim teamSheet As Worksheet
    On Error Resume Next
    Set teamSheet = ThisWorkbook.Sheets(userName)
    On Error GoTo 0

    If teamSheet Is Nothing Then
        Set teamSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        teamSheet.Name = userName

        ' Add headers
        teamSheet.Cells(1, 1).Value = "CaseID"
        teamSheet.Cells(1, 2).Value = "Status"
        teamSheet.Cells(1, 3).Value = "Comment"
        teamSheet.Cells(1, 4).Value = "Action Taken"
        teamSheet.Cells(1, 5).Value = "Completed Time"

        ' Format headers
        teamSheet.Range("A1:E1").Font.Bold = True
    End If

    ' Copy data
    Dim nextRow As Long
    nextRow = teamSheet.Cells(teamSheet.Rows.Count, "A").End(xlUp).Row + 1

    teamSheet.Cells(nextRow, 1).Value = ws.Cells(sourceRow, 1).Value ' CaseID
    teamSheet.Cells(nextRow, 2).Value = ws.Cells(sourceRow, 2).Value ' Status
    teamSheet.Cells(nextRow, 3).Value = ws.Cells(sourceRow, 5).Value ' Comment
    teamSheet.Cells(nextRow, 4).Value = ws.Cells(sourceRow, 6).Value ' ActionTaken
    teamSheet.Cells(nextRow, 5).Value = ws.Cells(sourceRow, 9).Value ' DroppedTime
End Sub

Sub GenerateWorkloadReport()
    ' Generate summary of cases by team member
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Dump")

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

    Dim teamMembers As Object
    Set teamMembers = CreateObject("Scripting.Dictionary")

    ' Count cases per team member
    Dim i As Long
    For i = 2 To lastRow
        Dim member As String
        member = ws.Cells(i, 3).Value

        If member <> "" Then
            If Not teamMembers.Exists(member) Then
                teamMembers.Add member, 1
            Else
                teamMembers(member) = teamMembers(member) + 1
            End If
        End If
    Next i

    ' Display report
    Dim report As String
    report = "Workload Report:" & vbCrLf & vbCrLf

    Dim key As Variant
    For Each key In teamMembers.Keys
        report = report & key & ": " & teamMembers(key) & " cases" & vbCrLf
    Next key

    MsgBox report, vbInformation, "Team Workload"
End Sub

Related Topics

case management ticketing assignment workflow tracking

Need Custom VBA Solutions?

Our AI-powered VBA generator can create custom code tailored to your specific requirements in seconds.

Free AI generations every month — top up with credit packs anytime

Related Templates

More VBA templates in the same category

Intermediate

Sheet Operations Manager

Add, rename, delete, and organise worksheets with advanced options

View Template