Best way to group survey results by ward reporting % of Yes results

R

roster

New Member
Joined
Apr 14, 2006
Messages
20
Not sure how to do this.

worksheet has the results of and audit. Y is that the ward was compliant for that question, N no, N/A and Unknown

column A has the wards audited
columns B-A0 have the answers to the survey Questions in the form of Y N N/A and Unknown


Eg
A B C
Ward Was the ID checked Consent valid...……………...
2a Y N
1f Y N
2a Y N/A
2d Y N
2a Y N
2a Y N

How collate the data in a new worksheet, group by ward and produce a table with number of audits and the percentage of Compliant (Y) responses?
example

Ward Number of Audits Was ID checked Consent valid
2a 4 100% 0%
2d etc
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Try this for results on sheet2.
Nb:- This code only does the first 4 columns, let me know if its basically correct and I will do the rest !!!

Code: 
[COLOR=navy]Sub[/COLOR] MG14Jul52
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n1 [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] n2 [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Q [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
n1 = IIf(Dn.Offset(, 1).Value = "Y", 1, 0)
n2 = IIf(Dn.Offset(, 2).Value = "Y", 1, 0)
[COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
    .Item(Dn.Value) = Array(n1, n2, 1)
[COLOR=navy]Else[/COLOR]
    Q = .Item(Dn.Value)
    Q(0) = Q(0) + n1
    Q(1) = Q(1) + n2
    Q(2) = Q(2) + 1
    .Item(Dn.Value) = Q
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]

ReDim ray(1 To .Count + 1, 1 To 4)
ray(1, 1) = "Ward": ray(1, 2) = "Number of Audits": ray(1, 3) = "Was ID Checked": ray(1, 4) = "Consent valid"
c = 1
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    c = c + 1
    ray(c, 1) = K
    ray(c, 2) = .Item(K)(2)
    ray(c, 3) = Format(.Item(K)(0) / .Item(K)(2), "0%")
    ray(c, 4) = Format(.Item(K)(1) / .Item(K)(2), "0%")
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Upvote 0
WOW thank you for replying.. It almost worked.. You have been so kind. I had posted this on the link below referenced kindly by Peter_SSs.

I've uploaded a file.. it is different to what you have supplied. Would appreciate your help!
 
Upvote 0
Try this for data in sheet "Data" to results in sheet "Results.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG14Jul56
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Data")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
   ReDim nray(1 To 40)
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(nray)
        nray(n) = IIf(UCase(Dn.Offset(, n).Value) = "Y", 1, 0)
    [COLOR="Navy"]Next[/COLOR] n
    .Item(Dn.Value) = Array(nray, 1)
      
[COLOR="Navy"]Else[/COLOR]
    Q = .Item(Dn.Value)
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Q(0))
        Q(0)(n) = Q(0)(n) + IIf(UCase(Dn.Offset(, n).Value) = "Y", 1, 0)
    [COLOR="Navy"]Next[/COLOR] n
    Q(1) = Q(1) + 1
    .Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
ReDim ray(1 To .Count + 1, 1 To 40)
[COLOR="Navy"]For[/COLOR] ac = 1 To UBound(ray, 2)
        ray(1, ac) = Rng(1).Offset(-1, ac - 1)
[COLOR="Navy"]Next[/COLOR] ac
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    c = c + 1
    ray(c, 1) = K
    [COLOR="Navy"]For[/COLOR] ac = 2 To UBound(ray, 2)
       ray(c, ac) = Format(.Item(K)(0)(ac - 1) / .Item(K)(1), "0%")
    [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Results").Range("A1").Resize(c, UBound(ray, 2))
    .Value = ray
    .Borders.Weight = 2
    .Parent.Rows(1).WrapText = True
    .Rows.AutoFit
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Spectacular Mick!!!!

Just wondering … (sheepishly asks) is there a way to create a column after ward that sums the amount of entries per ward?
 
Upvote 0
Try this for column 2 addition.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG15Jul40
'[COLOR="Green"][B]code 1 again Modified col column 2[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Data")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
   ReDim nray(1 To 41)
    [COLOR="Navy"]For[/COLOR] n = 3 To UBound(nray)
        nray(n) = IIf(UCase(Dn.Offset(, n - 2).Value) = "Y", 1, 0)
    [COLOR="Navy"]Next[/COLOR] n
    .Item(Dn.Value) = Array(nray, 1)
[COLOR="Navy"]Else[/COLOR]
    Q = .Item(Dn.Value)
    [COLOR="Navy"]For[/COLOR] n = 3 To UBound(Q(0))
        Q(0)(n) = Q(0)(n) + IIf(UCase(Dn.Offset(, n - 2).Value) = "Y", 1, 0)
    [COLOR="Navy"]Next[/COLOR] n
    Q(1) = Q(1) + 1
    .Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

ReDim ray(1 To .Count + 1, 1 To 41)
     [COLOR="Navy"]For[/COLOR] ac = 1 To UBound(ray, 2)
        [COLOR="Navy"]If[/COLOR] ac = 2 [COLOR="Navy"]Then[/COLOR]
            ray(1, ac) = "Count of Audits"
       [COLOR="Navy"]ElseIf[/COLOR] ac > 2 [COLOR="Navy"]Then[/COLOR]
            ray(1, ac) = Rng(1).Offset(-1, ac - 2)
       [COLOR="Navy"]Else[/COLOR]
            ray(1, ac) = Rng(1).Offset(-1, ac - 1)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] ac
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    c = c + 1
    ray(c, 1) = K
     ray(c, 2) = .Item(K)(1)
    [COLOR="Navy"]For[/COLOR] ac = 3 To UBound(ray, 2)
       ray(c, ac) = Format(.Item(K)(0)(ac) / .Item(K)(1), "0%")
    [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Results").Range("A1").Resize(c, UBound(ray, 2))
    .Value = ray
    .Borders.Weight = 2
    .Parent.Rows(1).WrapText = True
    .Rows.AutoFit
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Almost there. looks like the % are incorrect as there are n/a and unknown results. Could we assign a 0 value to these and have a percentage calculation like this yes/(yes+no)*100??
Thank you for your continued help!!!
 
Last edited:
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG20Jul15
'[COLOR="Green"][B]forum3[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Data")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
   ReDim nray(1 To 41, 1 To 2)
    [COLOR="Navy"]For[/COLOR] n = 3 To UBound(nray, 1)
        nray(n, 1) = IIf(UCase(Dn.Offset(, n - 2).Value) = "Y", 1, 0)
        [COLOR="Navy"]If[/COLOR] UCase(Dn.Offset(, n - 2).Value) = "Y" Or UCase(Dn.Offset(, n - 2).Value) = "N" [COLOR="Navy"]Then[/COLOR]
            nray(n, 2) = 1
        [COLOR="Navy"]Else[/COLOR]
           nray(n, 2) = 0
        [COLOR="Navy"]End[/COLOR] If
    
    
    [COLOR="Navy"]Next[/COLOR] n
    .Item(Dn.Value) = Array(nray, 1)
[COLOR="Navy"]Else[/COLOR]
    Q = .Item(Dn.Value)
    [COLOR="Navy"]For[/COLOR] n = 3 To UBound(Q(0))
        Q(0)(n, 1) = Q(0)(n, 1) + IIf(UCase(Dn.Offset(, n - 2).Value) = "Y", 1, 0)
        [COLOR="Navy"]If[/COLOR] UCase(Dn.Offset(, n - 2).Value) = "Y" Or UCase(Dn.Offset(, n - 2).Value) = "N" [COLOR="Navy"]Then[/COLOR]
            Q(0)(n, 2) = Q(0)(n, 2) + 1
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
    Q(1) = Q(1) + 1
    .Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] t, tt
ReDim ray(1 To .Count + 1, 1 To 41)
     [COLOR="Navy"]For[/COLOR] ac = 1 To UBound(ray, 2)
        [COLOR="Navy"]If[/COLOR] ac = 2 [COLOR="Navy"]Then[/COLOR]
            ray(1, ac) = "Count of Audits"
       [COLOR="Navy"]ElseIf[/COLOR] ac > 2 [COLOR="Navy"]Then[/COLOR]
            ray(1, ac) = Rng(1).Offset(-1, ac - 2)
       [COLOR="Navy"]Else[/COLOR]
            ray(1, ac) = Rng(1).Offset(-1, ac - 1)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] ac
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
     c = c + 1
     ray(c, 1) = K
     ray(c, 2) = .Item(K)(1)
       [COLOR="Navy"]For[/COLOR] ac = 3 To UBound(ray, 2)
          [COLOR="Navy"]If[/COLOR] .Item(K)(0)(ac, 1) = 0 [COLOR="Navy"]Then[/COLOR]
               ray(c, ac) = 0
          [COLOR="Navy"]Else[/COLOR]
               ray(c, ac) = Format(.Item(K)(0)(ac, 1) / .Item(K)(0)(ac, 2), "0%")
          [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] ray(c, ac) = "0%" [COLOR="Navy"]Then[/COLOR] ray(c, ac).NumberFormat = "0"
    [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Results").Range("A1").Resize(c, UBound(ray, 2))
    .Parent.Cells.NumberFormat = "general"
    .Value = ray
    .Borders.Weight = 2
    .Parent.Rows(1).WrapText = True
    .Rows.AutoFit
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
MsgBox "Code Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick!! Thanks again for replying... except for the audit count , Unfortunately the results are coming up as 0.. any suggestions?
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
VBA Solution to Search Text and Return Desired Result
2 3 4
Replies
34
Views
4K
plk0507
P
A
  • Question Question
First VBA Project - is there a better way to write this code?
Replies
0
Views
2K
akshay27
A
M
  • Question Question
Complicated transpose of data with conditions
Replies
3
Views
1K
mahmed1
M
DocAElstein
  • Question Question
VBA to expand an Outline ( Grouping ) . ( Open Grouped Rows )
Replies
1
Views
14K
DocAElstein
DocAElstein
B
  • Question Question
3 three CASCADING DATA VALIDATION (CATEGORY, DESCRIPTION and MODEL) PLEASE HELP ! ! ! ! ! ! Thank you and GOD BLESS....
2
Replies
14
Views
7K
Brixton11
B

Forum statistics

Threads
1,223,902
Messages
6,175,278
Members
452,629
Latest member
SahilPolekar

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top