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

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

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
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

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

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