# Count Results

There are three worksheets
1. Priorities - Lists all the Priorities in column A that will be used in responses on the Responses worksheet
2. Responses - Each row is a set of responses by a user and there may be up to 50 user responses.  I will populate these manually.  The worksheet has some examples.  The responses going across the row can go up to 150 after the name in column b.
3. Results - Counts the responses for every row by user that is in the responses worksheet. The responses are are totaled in the last column. (or on a separate worksheet if easier)

When you look at the attached file you can see two examples.
CountResults.xlsx
###### Who is Participating?

You can do this with a simple way.
Check the attached file.
CountResults.xlsx
0

Commented:
Hi,
Why you don't use countif only
In cell B2 = COUNTIF(Responses!\$2:\$2,\$A2)
In cell C2 =COUNTIF(Responses!\$3:\$3,\$A2)
0

Distinguished Expert - 2017Commented:
If you are into VBA solution, then try below:
``````Sub UpdateResults()
Dim RespSh As Worksheet, PriotSh As Worksheet, TestSh As Worksheet, xWs As Worksheet
Dim RespLR As Long, PriotLR As Long, LRow As Long, LCol As Long, RowIndex As Long, ColIndex As Long

'Define Variables
Set RespSh = Worksheets("Responses")
Set PriotSh = Worksheets("Priorities")
RespLR = RespSh.Cells(Rows.Count, "B").End(xlUp).Row
PriotLR = PriotSh.Cells(Rows.Count, "A").End(xlUp).Row

'Disable Events
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With

'Delete Test Sheet
For Each xWs In ThisWorkbook.Worksheets
If xWs.Name = "Test" Then
xWs.Delete
End If
Next

'Create New Sheet
With ThisWorkbook
End With
TestSh.Name = "Test"

'Copy Unique Names
RespSh.Range("B1:B" & RespLR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=TestSh.Range("A1"), Unique:=True

'Copy Priorities
PriotSh.Range("A1:A" & PriotLR).Copy
TestSh.Range("B1").PasteSpecial xlPasteValues, Transpose:=True
Application.CutCopyMode = False

'Update Formula
LRow = TestSh.Cells(Rows.Count, "A").End(xlUp).Row
LCol = TestSh.Cells(1, Columns.Count).End(xlToLeft).Column
TestSh.Cells(1, LCol + 1).Value = "Total"
For RowIndex = 2 To LRow
For ColIndex = 2 To LCol
With TestSh.Cells(RowIndex, ColIndex)
.FormulaR1C1 = "=SUMPRODUCT((NameList=RC1)*(DataList=R1C))"
End With
With TestSh.Cells(RowIndex, LCol + 1)
.FormulaR1C1 = "=SUM(RC2:RC[-1])"
End With
Next ColIndex
Next RowIndex
TestSh.Activate
TestSh.Range("A1").Select

'Enable Events
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
``````
In Attached, just click Update Result, it will create a new sheet "Test" with required output.
Kindly Note: Before applying above macro into your original workbook, you need to create Two Named Range as below:
DataList:
``````=OFFSET(Responses!\$C\$2,0,0,COUNTA(Responses!\$C:\$C),COUNTA(Responses!\$2:\$2))
``````
NameList:
``````=OFFSET(Responses!\$B\$2, 0, 0, COUNT(IF(Responses!\$B\$2:\$B\$1000="", "", 1)), 1)
``````
CountResults_v1.xlsm
0

Distinguished Expert - 2017Commented:
WOW! Initially you asked for VBA solution, have you tried my solution?
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.