Yes, but that would require a bit of doing.
Sub Tabulate() Columns("A:C").Select // will insert 3 new columns here Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("D1").Select // top-left of data is now at cell "D1" Selection.CurrentRegion.Select // selects the UserInfo String data block datablock = Selection.Address // saves the address of the block optionCount = 0 // initialize count of options listed in scoring table For voter = 0 To Selection.Rows.Count - 1 // for each voter For tier = 0 To 4 // for each selection by that voter option = Range(datablock).Cells(voter * 5 + tier) // get option name If option = Null Then ElseIf option = "" Then Else // option was found optionPoints = 0 // initial points for option For Each cell In Range(datablock) // for each entry in block If cell = option Then optionPoints = optioinPoints + 9 - cell.Column // add score cell.Cells(1).Value = "" // remove selection from block End If Next cell Range("A1").Offset(optionCount).Cells(1).Value = option // add option to scoring list Range("A1").Offset(optionCount, 1).Cells(1).Value = optionPoints // add score to list optionCount = optionCount + 1 // increment count of listed scores End If Next tier Next voter End Sub