Statistical Analysis Dashboard

' Statistical Analysis Dashboard
' Analyze data with grouping, statistics, and deviation detection

Sub PerformStatisticalAnalysis()
    ' Main analysis procedure with user input
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    ' Browse for file
    Dim filePath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select Excel File for Analysis"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx;*.xls;*.xlsm"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        filePath = .SelectedItems(1)
    End With

    ' Open workbook
    Dim analysisWB As Workbook
    Set analysisWB = Workbooks.Open(filePath, ReadOnly:=True)

    Dim ws As Worksheet
    Set ws = analysisWB.Sheets(1)

    ' Get X column (grouping column)
    Dim xCol As String
    xCol = InputBox("Enter column letter for X axis (grouping - e.g., months):", "X Column", "A")
    If xCol = "" Then Exit Sub

    ' Get Y column (values to analyse)
    Dim yCol As String
    yCol = InputBox("Enter column letter for Y axis (values - e.g., sales):", "Y Column", "B")
    If yCol = "" Then Exit Sub

    ' Get statistical operation
    Dim operation As String
    operation = InputBox("Enter statistical operation:" & vbCrLf & _
                       "SUM, COUNT, AVERAGE, MAX, MIN, STDEV", "Operation", "AVERAGE")
    operation = UCase(Trim(operation))

    ' Get deviation threshold
    Dim deviationThreshold As Double
    deviationThreshold = Val(InputBox("Enter deviation threshold (e.g., 0.1 for 10%):", "Deviation", "0.1"))

    ' Perform grouping and calculations
    Dim results As Object
    Set results = CreateObject("Scripting.Dictionary")

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

    ' Group data
    Dim i As Long
    For i = 2 To lastRow ' Assuming row 1 is header
        Dim groupKey As String
        Dim groupValue As Double

        groupKey = CStr(ws.Range(xCol & i).Value)
        groupValue = Val(ws.Range(yCol & i).Value)

        If Not results.Exists(groupKey) Then
            ' Create new collection for this group
            Dim valueCollection As Object
            Set valueCollection = CreateObject("System.Collections.ArrayList")
            valueCollection.Add groupValue
            results.Add groupKey, valueCollection
        Else
            ' Add to existing group
            results(groupKey).Add groupValue
        End If
    Next i

    ' Calculate statistics for each group
    Dim statsResults As Object
    Set statsResults = CreateObject("Scripting.Dictionary")

    Dim key As Variant
    For Each key In results.Keys
        Dim values As Object
        Set values = results(key)

        Dim statValue As Double
        statValue = CalculateStatistic(values, operation)

        statsResults.Add key, statValue
    Next key

    ' Calculate mean of all group statistics
    Dim meanValue As Double
    meanValue = CalculateMean(statsResults)

    ' Detect deviations
    Dim deviations As Object
    Set deviations = CreateObject("Scripting.Dictionary")

    For Each key In statsResults.Keys
        Dim value As Double
        value = statsResults(key)

        Dim deviation As Double
        deviation = (value - meanValue) / meanValue ' Percentage deviation

        If Abs(deviation) > deviationThreshold Then
            deviations.Add key, deviation
        End If
    Next key

    ' Create results sheet
    Call CreateResultsSheet(statsResults, meanValue, deviations, operation, deviationThreshold)

    analysisWB.Close SaveChanges:=False

    Application.ScreenUpdating = True

    MsgBox "Statistical analysis complete! Results in 'Analysis Results' sheet.", vbInformation

    Exit Sub

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

Function CalculateStatistic(values As Object, operation As String) As Double
    ' Calculate requested statistic for collection of values
    Dim result As Double
    Dim sum As Double
    Dim count As Long
    Dim i As Long

    count = values.Count

    Select Case operation
        Case "SUM"
            For i = 0 To count - 1
                sum = sum + values(i)
            Next i
            result = sum

        Case "COUNT"
            result = count

        Case "AVERAGE"
            For i = 0 To count - 1
                sum = sum + values(i)
            Next i
            result = sum / count

        Case "MAX"
            result = values(0)
            For i = 1 To count - 1
                If values(i) > result Then result = values(i)
            Next i

        Case "MIN"
            result = values(0)
            For i = 1 To count - 1
                If values(i) < result Then result = values(i)
            Next i

        Case "STDEV"
            ' Calculate standard deviation
            Dim mean As Double
            For i = 0 To count - 1
                sum = sum + values(i)
            Next i
            mean = sum / count

            Dim variance As Double
            For i = 0 To count - 1
                variance = variance + ((values(i) - mean) ^ 2)
            Next i
            variance = variance / count
            result = Sqr(variance)

        Case Else
            result = 0
    End Select

    CalculateStatistic = result
End Function

Function CalculateMean(statsDict As Object) As Double
    ' Calculate mean of all statistics
    Dim sum As Double
    Dim count As Long

    Dim key As Variant
    For Each key In statsDict.Keys
        sum = sum + statsDict(key)
        count = count + 1
    Next key

    If count > 0 Then
        CalculateMean = sum / count
    Else
        CalculateMean = 0
    End If
End Function

Sub CreateResultsSheet(statsResults As Object, meanValue As Double, deviations As Object, operation As String, threshold As Double)
    ' Create formatted results sheet
    Dim resultsWS As Worksheet

    On Error Resume Next
    Set resultsWS = ThisWorkbook.Sheets("Analysis Results")
    On Error GoTo 0

    If resultsWS Is Nothing Then
        Set resultsWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        resultsWS.Name = "Analysis Results"
    Else
        resultsWS.Cells.Clear
    End If

    ' Title
    resultsWS.Cells(1, 1).Value = "Statistical Analysis Results"
    resultsWS.Cells(1, 1).Font.Size = 14
    resultsWS.Cells(1, 1).Font.Bold = True

    resultsWS.Cells(2, 1).Value = "Operation: " & operation
    resultsWS.Cells(3, 1).Value = "Mean: " & Format(meanValue, "0.00")
    resultsWS.Cells(4, 1).Value = "Deviation Threshold: " & Format(threshold * 100, "0.00") & "%"

    ' Headers
    resultsWS.Cells(6, 1).Value = "Group"
    resultsWS.Cells(6, 2).Value = "Value"
    resultsWS.Cells(6, 3).Value = "Deviation from Mean"
    resultsWS.Cells(6, 4).Value = "Status"
    resultsWS.Range("A6:D6").Font.Bold = True

    ' Write results
    Dim row As Long
    row = 7

    Dim key As Variant
    For Each key In statsResults.Keys
        resultsWS.Cells(row, 1).Value = key
        resultsWS.Cells(row, 2).Value = statsResults(key)
        resultsWS.Cells(row, 2).NumberFormat = "0.00"

        Dim deviation As Double
        deviation = (statsResults(key) - meanValue) / meanValue

        resultsWS.Cells(row, 3).Value = deviation
        resultsWS.Cells(row, 3).NumberFormat = "0.00%"

        If deviations.Exists(key) Then
            resultsWS.Cells(row, 4).Value = "Outlier"
            resultsWS.Cells(row, 4).Interior.Color = RGB(255, 200, 200)
        Else
            resultsWS.Cells(row, 4).Value = "Normal"
        End If

        row = row + 1
    Next key

    ' Auto-fit
    resultsWS.Columns("A:D").AutoFit
End Sub