Option Explicit
Public Sub Benford_ColumnG_ToSheet_MacFixed()
Const DATA_SHEET_NAME As String = "2018" ' e.g., "Data"; blank "" = ActiveSheet
Const DATA_COL As String = "G" ' change if your numbers are in a different column
Const START_ROW As Long = 2 ' set to 1 if no header row
Dim wsData As Worksheet, wsOut As Worksheet
Dim lastRow As Long, i As Long
Dim arr As Variant, v As Variant
Dim counts(1 To 9) As Long
Dim total As Long, d As Long
Dim expected As Double, obs As Double
Dim chisq As Double, mad As Double
Dim chartObj As ChartObject
Dim co As ChartObject
On Error GoTo CleanFail
Application.ScreenUpdating = False
Application.EnableEvents = False
' Pick the data sheet
If Len(DATA_SHEET_NAME) > 0 Then
Set wsData = ThisWorkbook.Worksheets(DATA_SHEET_NAME)
Else
Set wsData = ActiveSheet
End If
' Find last row with data in the chosen column
lastRow = wsData.Cells(wsData.Rows.Count, DATA_COL).End(xlUp).Row
If lastRow < START_ROW Then
MsgBox "No data found in column " & DATA_COL & " at or below row " & START_ROW & ".", vbExclamation
GoTo CleanExit
End If
' Load to array (fast)
arr = wsData.Range(DATA_COL & START_ROW & ":" & DATA_COL & lastRow).Value
' Count first significant digits
total = 0
For i = 1 To UBound(arr, 1)
v = arr(i, 1)
d = FirstSignificantDigitFromValue(v) ' 0 if none/zero
If d >= 1 And d <= 9 Then
counts(d) = counts(d) + 1
total = total + 1
End If
Next i
If total = 0 Then
MsgBox "No analyzable values (first digit 1–9) found in column " & DATA_COL & ".", vbExclamation
GoTo CleanExit
End If
' Create/clear output sheet
On Error Resume Next
Set wsOut = ThisWorkbook.Worksheets("Benford")
On Error GoTo 0
If wsOut Is Nothing Then
Set wsOut = ThisWorkbook.Worksheets.Add(After:=wsData)
wsOut.Name = "Benford"
Else
wsOut.Cells.Clear
End If
With wsOut
' Headers
.Range("A1:E1").Value = Array("Digit", "Count", "% of Total", "Benford %", "Diff (Obs - Exp)")
.Range("A1:E1").Font.Bold = True
' Body
For d = 1 To 9
.Cells(d + 1, "A").Value = d
.Cells(d + 1, "B").Value = counts(d)
.Cells(d + 1, "D").Value = Log(1# + 1# / d) / Log(10#) ' Benford expected %
Next d
.Range("A11").Value = "Total"
.Range("B11").FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
.Range("C2:C10").FormulaR1C1 = "=RC[-1]/R11C2" ' observed %
.Range("E2:E10").FormulaR1C1 = "=RC[-2]-RC[-1]" ' diff %
.Range("B2:B11").NumberFormat = "0"
.Range("C2:C10,D2:D10,E2:E10").NumberFormat = "0.000%"
.Columns("A:E").AutoFit
' Chi-square
chisq = 0#
For d = 1 To 9
expected = total * .Cells(d + 1, "D").Value
chisq = chisq + ((counts(d) - expected) ^ 2) / expected
Next d
.Range("A13").Value = "Chi-square"
.Range("B13").Value = chisq
' p-value (df=8) via worksheet formula (works on Mac/Win)
.Range("A14").Value = "p-value (df=8)"
.Range("B14").Formula = "=IFERROR(CHISQ.DIST.RT(B13,8),IFERROR(CHIDIST(B13,8),""n/a""))"
.Range("B14").NumberFormat = "0.0000"
' MAD and class
mad = 0#
For d = 1 To 9
obs = .Cells(d + 1, "C").Value
expected = .Cells(d + 1, "D").Value
mad = mad + Abs(obs - expected)
Next d
mad = mad / 9#
.Range("A15").Value = "MAD"
.Range("B15").Value = mad
.Range("B15").NumberFormat = "0.0000"
.Range("A16").Value = "MAD Class"
.Range("B16").Formula = "=IF(B15<0.006,""Close conformity"",IF(B15<0.012,""Acceptable"",IF(B15<0.015,""Marginal"",""Nonconformity"")))"
' Remove any existing charts (Mac-stable)
For Each co In .ChartObjects
co.Delete
Next co
' Add chart
Set chartObj = .ChartObjects.Add(Left:=.Range("G2").Left, Top:=.Range("G2").Top, Width:=420, Height:=280)
With chartObj.Chart
.ChartType = xlColumnClustered
Do While .SeriesCollection.Count > 0
.SeriesCollection(1).Delete
Loop
With .SeriesCollection.NewSeries
.Name = "% Observed"
.XValues = wsOut.Range("A2:A10") ' *** Mac-safe: explicit worksheet ***
.Values = wsOut.Range("C2:C10")
End With
With .SeriesCollection.NewSeries
.Name = "Benford %"
.XValues = wsOut.Range("A2:A10") ' *** Mac-safe: explicit worksheet ***
.Values = wsOut.Range("D2:D10")
End With
.HasTitle = True
.ChartTitle.Text = "Benford's Law ? First Digit (" & wsData.Name & "!" & DATA_COL & ")"
.Axes(xlValue).TickLabels.NumberFormat = "0%"
.Legend.Position = xlLegendPositionBottom
End With
End With
MsgBox "Benford analysis complete. See the 'Benford' sheet.", vbInformation
CleanExit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
CleanFail:
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Error: " & Err.Description, vbExclamation
End Sub
' First significant digit helper (unchanged)
Private Function FirstSignificantDigitFromValue(ByVal v As Variant) As Integer
Dim x As Double
Dim s As String
Dim i As Long, ch As Integer
If IsNumeric(v) Then
x = Abs(CDbl(v))
If x = 0# Then
FirstSignificantDigitFromValue = 0
Exit Function
End If
Do While x >= 10#
x = x / 10#
Loop
Do While x < 1#
x = x * 10#
Loop
FirstSignificantDigitFromValue = Int(x)
If FirstSignificantDigitFromValue < 1 Or FirstSignificantDigitFromValue > 9 Then
FirstSignificantDigitFromValue = 0
End If
Else
s = CStr(v)
For i = 1 To Len(s)
ch = Asc(Mid$(s, i, 1))
If ch >= 49 And ch <= 57 Then
FirstSignificantDigitFromValue = ch - 48
Exit Function
End If
Next i
FirstSignificantDigitFromValue = 0
End If
End Function
the only thing you have to change is the name of the sheet you want analysed and the column that your data are everthing else is copy paste and it works on macos too
posting this because i couldnt find it anywhere else for excel vba and i want people to have it enter image description here
