Sub WtdRtg()
Const MyName As String = "WtdRtg" 'The name of this macro for error messages
' Some constants
Const MinRows As Long = 1 'Table must have at least 1 row
Const MinCols As Long = 3 'Table must have at least 3 columns (name, wtdrtg, 1 attribute)
Const WRCol As Long = 2 'The weighted rating column
' Worker variables
Dim iCol As Long 'Loop index
Dim iRow As Long 'Loop index
' Get the name of the table
Const rnTableName As String = "TableName" 'The name of the cell with the name of the table
Dim rnTable As String 'The name of the table
rnTable = Range(rnTableName).Value2 '.Load the table name
' Define a ListObject variable. It will replace ActiveSheet.ListObject in the rest of the code
Dim loTable As ListObject
Set loTable = Range(rnTable).ListObject
' Load the headers into one array and the body into another
Dim arrTableHdr As Variant 'The table header row
arrTableHdr = loTable.HeaderRowRange.Value2
Dim arrTableData As Variant 'The table data (body)
arrTableData = loTable.DataBodyRange.Value2
'Do some validity checking
Dim NumRows As Long: NumRows = UBound(arrTableData, 1) 'Get the number of rows
If NumRows < MinRows Then
MsgBox "Table has less than " & MinRows & " rows": Exit Sub: End If
Dim NumCols As Long: NumCols = UBound(arrTableData, 2) 'Get the number of columns
If NumCols < MinCols Then
MsgBox "Table has less than " & MinCols & " columns": Exit Sub: End If
'Calculate the means and std deviations (just the data columns)
Dim arrMeans() As Double: ReDim arrMeans(NumCols) 'The means for each data column
Dim arrStdDevs() As Double: ReDim arrStdDevs(NumCols) 'The std devs for each data column
Dim arrNextCol() As Variant: ReDim arrNextCol(NumRows) 'The property data in the next column
For iRow = 1 To NumRows 'Zero the WtdRtgs
arrTableData(iRow, WRCol) = 0
Next iRow
For iCol = MinCols To NumCols
With Application.WorksheetFunction
arrNextCol = .Index(arrTableData, 0, iCol)
arrMeans(iCol) = .Average(arrNextCol)
arrStdDevs(iCol) = .StDev_S(arrNextCol)
End With
For iRow = 1 To NumRows
arrTableData(iRow, WRCol) = arrTableData(iRow, WRCol) + _
((arrTableData(iRow, iCol) - arrMeans(iCol)) / arrStdDevs(iCol))
Next iRow
Next iCol
' Write out just weighted ratings column (2) of the array
loTable.ListColumns(arrTableHdr(1, WRCol)).DataBodyRange.Resize(UBound(arrTableData, 1)) _
= Application.Index(arrTableData, 0, WRCol)
End Sub