I made a simple script that formats the output from the LibInsight export and automatically generates a Category column. Here’s how it works: If the text in the Information field contains any of the following substrings: “notecard,” “note card,” “paper,” “glue,” “scissor,” “envelope,” “ pen ,” “pencil,” “ruler,” “staple,” “marker,” “posterboard,” “sticky,” “coloring,” “supply” then the script assigns the category SUPPLY. It does this for every row. It’s a little brute-force, but it currently categorizes a bit more than half of the questions into the following categories (based on my best guesses for what you might want): BATTERY BLUEBOOK BOOKSTORE CHARGER EQUIPMENT FAX FIRST-AID GAMES HOURS IT JOB LAS LOCKER LOST MAIL PRINTING RESTROOM SCANNER STUDY SUPPLY VENDING You can use these as-is, or let me know what categories you’d prefer — we can then figure out what strings each should match. I’ve attached a table showing the current substring replacements if you’d like to review it. A few notes: Order matters — later rules overwrite earlier ones, and each row can only have one category. For example, if “Laptop” maps to EQUIPMENT and “Charger” maps to CHARGER, a note saying “student wants a laptop charger” will end up in whichever category appears last in the list. The matching is greedy — if you include something broad like “IT,” then “Sustainability” will also get categorized as IT. Let me know if you’d like to make any changes or talk through how the rules should be ordered. Or if this isn’t what you want, that’s fine, just let me know. When you’re happy with it I can put the macro on your computer or you can just ask me when you want me to send you a report and what date range you want. Code is below in case I get raptured. Public Sub ConvertQueryData() Dim mySearchTerms As Variant Dim myReplacementText As String Call CreatePrintSheet Call DeleteColumnsDeskQueries Call DeleteRowsWithBlankCells Columns("C").Insert Call SetColWidths Call ProcessColumnReplacements(Array("notecard", "note card", "paper", "glue", "scissor", "envelope", " pen ", "pencil", "ruler", "staple", "marker", "posterboard", "sticky", "coloring", "supply"), "SUPPLY") Call ProcessColumnReplacements(Array("bookstore", "book store"), "BOOKSTORE") Call ProcessColumnReplacements(Array("bluebook", "blue book"), "BLUEBOOK") Call ProcessColumnReplacements(Array("calculator", "scientific", "graphing", "headphone", "adapter", "cord", "cable", "keyboard", "mouse"), "EQUIPMENT") Call ProcessColumnReplacements(Array("charger", "charging", "charge"), "CHARGER") Call ProcessColumnReplacements(Array("vend", "goggles"), "VENDING") Call ProcessColumnReplacements(Array("bandaid", "band aid", "band-aid", "antiseptic", "first aid", "first-aid"), "FIRST-AID") Call ProcessColumnReplacements(Array("scan"), "SCANNER") Call ProcessColumnReplacements(Array("lost", "found", "missing"), "LOST AND FOUND") Call ProcessColumnReplacements(Array("lts", "laptop", "wifi", "network", "internet"), "IT") Call ProcessColumnReplacements(Array("print", "printer", "printing"), "PRINTING") Call ProcessColumnReplacements(Array("studyroom", "study room", "booking"), "STUDY ROOMS") Call ProcessColumnReplacements(Array("locker"), "LOCKER") Call ProcessColumnReplacements(Array("appeal", "fine"), "LAS") Call ProcessColumnReplacements(Array("hour", "time", "closing", "close"), "HOURS") Call ProcessColumnReplacements(Array("fax"), "FAX") Call ProcessColumnReplacements(Array("job", "employment", "hire"), "JOB") Call ProcessColumnReplacements(Array("battery", "batteries"), "BATTERY") Call ProcessColumnReplacements(Array("mail", "stamp"), "MAIL") Call ProcessColumnReplacements(Array("puzzle", "game"), "GAMES") Call ProcessColumnReplacements(Array("bath", "restroom"), "RESTROOM") End Sub Private Sub CreatePrintSheet() Set originalSheet = Application.ActiveSheet originalSheetName = originalSheet.Name originalSheet.Copy After:=Sheets(Application.Worksheets.Count) Set printSheet = Application.ActiveSheet printSheet.Name = "ToPrint" printSheet.Activate End Sub Private Sub DeleteColumnsDeskQueries() Range("A:A,C:E,G:I,K:P").Delete Shift:=xlToLeft End Sub Private Sub DeleteRowsWithBlankCells() Dim lastRow As Long Dim BlankCells As Range Dim TargetColumn As String Dim CheckColumn As String ' Set the column you want to check for blanks (e.g., "C") TargetColumn = "C" CheckColumn = "A" ' Find the last used row in the target column lastRow = Cells(Rows.Count, CheckColumn).End(xlUp).Row ' Define the range to search for blanks On Error Resume Next ' Handles the case where there are no blank cells Set BlankCells = Range(TargetColumn & "1:" & TargetColumn & lastRow).SpecialCells(xlCellTypeBlanks) On Error GoTo 0 ' Select the entire rows for the blank cells found If Not BlankCells Is Nothing Then BlankCells.EntireRow.Delete Else MsgBox "No blank cells found in column " & TargetColumn & ".", vbInformation End If End Sub Private Sub SetColWidths() Columns("A").AutoFit Columns("B").AutoFit Columns("C").ColumnWidth = 20 Columns("D").ColumnWidth = 50 End Sub Sub ProcessColumnReplacements(searchSubstrings As Variant, replacementString As String) Const COLUMN_TO_SEARCH As Long = 4 ' Column D Const COLUMN_TO_UPDATE As Long = 3 ' Column C Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim D_Value As String Dim subString As Variant Dim matchFound As Boolean Set ws = ActiveSheet If Not IsArray(searchSubstrings) Then MsgBox "The first argument must be an array of substrings.", vbExclamation Exit Sub End If lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For r = 1 To lastRow matchFound = False D_Value = Trim(CStr(ws.Cells(r, COLUMN_TO_SEARCH).Value)) If D_Value <> "" Then For Each subString In searchSubstrings ' Check if the substring is present in the Column D value. ' vbTextCompare makes the search case-insensitive (e.g., "apple" matches "Apple"). If InStr(1, D_Value, Trim(CStr(subString)), vbTextCompare) > 0 Then matchFound = True ws.Cells(r, COLUMN_TO_UPDATE).Value = replacementString ' Stop checking other substrings for this row and move to the next row Exit For End If Next subString End If Next r End Sub