Count Results

Please see attach spreadsheet for example,

Can you please help me automate the counting of records using a macro.

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.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

abbas abdullaCommented:
Why you don't use countif only
In cell B2 = COUNTIF(Responses!$2:$2,$A2)
In cell C2 =COUNTIF(Responses!$3:$3,$A2)
Máté FarkasDatabase Developer and AdministratorCommented:
You can do this with a simple way.
Check the attached file.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ShumsExcel & VBA ExpertCommented:
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
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Worksheets
    If xWs.Name = "Test" Then
    End If
Application.DisplayAlerts = True

'Create New Sheet
With ThisWorkbook
    Set TestSh = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
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

'Enable Events
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

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:

Open in new window

=OFFSET(Responses!$B$2, 0, 0, COUNT(IF(Responses!$B$2:$B$1000="", "", 1)), 1)

Open in new window

ShumsExcel & VBA ExpertCommented:
WOW! Initially you asked for VBA solution, have you tried my solution?
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.