Survey Feedback Processor

' ============================================================================
' Survey Feedback Processor - Complete Solution
' vbacode.io Pro Template
' ============================================================================
' This macro provides a complete solution for processing survey feedback:
' 1. Cleans and standardizes names
' 2. Creates individual sheets for each person
' 3. Generates charts and calculates statistics
'
' Perfect for: Student feedback, employee evaluations, customer surveys
' ============================================================================

Sub ProcessSurveyFeedback()
    ' Main procedure - calls all steps in sequence

    On Error GoTo ErrorHandler

    ' Step 1: Clean and standardize data
    Call CleanSurveyData

    ' Step 2: Create individual sheets
    Call CreateIndividualSheets

    ' Step 3: Generate charts and statistics
    Call GenerateChartsAndStats

    MsgBox "Survey processing complete!" & vbCrLf & vbCrLf & _
           "✓ Data cleaned and standardized" & vbCrLf & _
           "✓ Individual sheets created" & vbCrLf & _
           "✓ Charts and statistics generated", vbInformation, "Success"

    Exit Sub

ErrorHandler:
    MsgBox "Error in survey processing: " & Err.Description, vbCritical
End Sub

Sub CleanSurveyData()
    ' Step 1: Clean and standardize names in the survey data

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim nameColumn As Long

    Set ws = ActiveSheet
    nameColumn = 1  ' Column A contains names - adjust if needed

    Application.ScreenUpdating = False

    ' Find last row
    lastRow = ws.Cells(ws.Rows.Count, nameColumn).End(xlUp).Row

    ' Clean each name
    For Each cell In ws.Range(ws.Cells(2, nameColumn), ws.Cells(lastRow, nameColumn))
        If Not IsEmpty(cell.Value) Then
            ' Trim whitespace
            cell.Value = Trim(cell.Value)

            ' Standardize to Proper Case (First Letter Uppercase)
            cell.Value = Application.WorksheetFunction.Proper(cell.Value)

            ' Remove multiple spaces
            Do While InStr(cell.Value, "  ") > 0
                cell.Value = Replace(cell.Value, "  ", " ")
            Loop
        End If
    Next cell

    Application.ScreenUpdating = True
End Sub

Sub CreateIndividualSheets()
    ' Step 2: Create individual sheets for each unique person

    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim uniqueNames As Collection
    Dim cell As Range
    Dim personName As Variant
    Dim lastRow As Long
    Dim nameColumn As Long
    Dim destRow As Long

    Set wsSource = ActiveSheet
    nameColumn = 1  ' Column A

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' Find last row
    lastRow = wsSource.Cells(wsSource.Rows.Count, nameColumn).End(xlUp).Row

    ' Get unique names
    Set uniqueNames = New Collection
    On Error Resume Next
    For Each cell In wsSource.Range(wsSource.Cells(2, nameColumn), wsSource.Cells(lastRow, nameColumn))
        If Not IsEmpty(cell.Value) Then
            uniqueNames.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0

    ' Create sheet for each person
    For Each personName In uniqueNames
        ' Create new sheet
        Set wsNew = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsNew.Name = Left(personName, 31)  ' Excel sheet name limit

        ' Copy headers
        wsSource.Rows(1).Copy wsNew.Rows(1)

        ' Copy data for this person
        destRow = 2
        For Each cell In wsSource.Range(wsSource.Cells(2, nameColumn), wsSource.Cells(lastRow, nameColumn))
            If cell.Value = personName Then
                wsSource.Rows(cell.Row).Copy wsNew.Rows(destRow)
                destRow = destRow + 1
            End If
        Next cell

        ' Format sheet
        wsNew.Rows(1).Font.Bold = True
        wsNew.Rows(1).Interior.Color = RGB(68, 114, 196)
        wsNew.Rows(1).Font.Color = RGB(255, 255, 255)
        wsNew.Columns.AutoFit
    Next personName

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Sub GenerateChartsAndStats()
    ' Step 3: Generate charts and statistics for each person's sheet

    Dim ws As Worksheet
    Dim chartObj As ChartObject
    Dim lastRow As Long
    Dim scoreColumn As Long
    Dim avgScore As Double

    Application.ScreenUpdating = False

    ' Process each worksheet (skip the source data sheet)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index > 1 Then  ' Skip first sheet (source data)
            With ws
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

                ' Assuming scores are in columns 3-6 (C-F)
                ' Adjust based on your survey structure
                scoreColumn = 3

                ' Calculate average score
                If lastRow > 1 Then
                    avgScore = Application.WorksheetFunction.Average(.Range(.Cells(2, scoreColumn), .Cells(lastRow, scoreColumn)))

                    ' Add summary section
                    .Cells(lastRow + 3, 1).Value = "Summary Statistics"
                    .Cells(lastRow + 3, 1).Font.Bold = True
                    .Cells(lastRow + 4, 1).Value = "Average Score:"
                    .Cells(lastRow + 4, 2).Value = Round(avgScore, 2)
                    .Cells(lastRow + 5, 1).Value = "Total Responses:"
                    .Cells(lastRow + 5, 2).Value = lastRow - 1

                    ' Create bar chart of scores
                    Set chartObj = .ChartObjects.Add(Left:=300, Top:=lastRow * 15 + 50, Width:=400, Height:=250)
                    With chartObj.Chart
                        .SetSourceData Source:=ws.Range(ws.Cells(1, scoreColumn), ws.Cells(lastRow, scoreColumn))
                        .ChartType = xlColumnClustered
                        .HasTitle = True
                        .ChartTitle.Text = "Feedback Scores for " & ws.Name
                        .HasLegend = False
                    End With
                End If
            End With
        End If
    Next ws

    Application.ScreenUpdating = True
End Sub

' ============================================================================
' Optional: Export Individual Sheets to PDF
' ============================================================================
Sub ExportSheetsToPDF()
    ' Export each person's sheet as a separate PDF file
    ' Useful for distributing feedback to individuals

    Dim ws As Worksheet
    Dim pdfPath As String
    Dim folderPath As String

    ' Get folder path for PDFs
    folderPath = ThisWorkbook.Path & "\Feedback_PDFs\"

    ' Create folder if it doesn't exist
    On Error Resume Next
    MkDir folderPath
    On Error GoTo 0

    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets
        If ws.Index > 1 Then  ' Skip source data sheet
            pdfPath = folderPath & ws.Name & "_Feedback.pdf"
            ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard
        End If
    Next ws

    Application.ScreenUpdating = True

    MsgBox "PDFs exported to: " & folderPath, vbInformation
End Sub