asked on

Needs Help Transferring Array Count Data To Barchart

Hi all,

The responses are taken from Question 1 and Question 2 's columns respectively

I have this code and it works as I want it to, since the messagebox values are correct. However, I was hoping that someone can help me delete and edit the messagebox part of the code as I now want to use the array count to make a barchart/histogram.

Sub GetArrayCount()

Dim Ws As Worksheet
Dim LRow As Long, i As Long
Dim r As New Collection, a
Dim DataRng1 As Range, DataRng2 As Range
Dim MyArr() As Variant

Set Ws = Worksheets("Sheet1")
LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row
Set DataRng1 = Ws.Range("D2:D11" & LRow)
Set DataRng2 = Ws.Range("E2:E11" & LRow)
MyArr = Array("Average", "Excellent", "Good", "Poor")

Application.ScreenUpdating = False

For Each a In MyArr
    r.Add a, a
Next a
For i = 1 To r.Count
    MsgBox Ws.Range("Q2").Value & "Q1 " & r(i) & " - " & Application.WorksheetFunction.CountIf(DataRng1, r(i))
   
Next
For i = 1 To r.Count
 MsgBox Ws.Range("Q3").Value & "Q2 " & r(i) & " - " & Application.WorksheetFunction.CountIf(DataRng2, r(i))
Next
Application.ScreenUpdating = True
End Sub

Open in new window

I have attached an example file. Any help is much aprreciated! :)
Book2.xlsm

Saqib Husain

This modification to the code will produce a table at G2 (you can change this on line 21). You can then use the table to plot the graph of your choice. Hence on you just need to run the macro with changed data and the graph will update itself.

Sub GetArrayCount()

Dim Ws As Worksheet
Dim LRow As Long, i As Long
Dim r As New Collection, a
Dim DataRng1 As Range, DataRng2 As Range
Dim MyArr() As Variant

Set Ws = Worksheets("Sheet1")
LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row
Set DataRng1 = Ws.Range("D2:D" & LRow)
Set DataRng2 = Ws.Range("E2:E" & LRow)
MyArr = Array("Average", "Excellent", "Good", "Poor")

Application.ScreenUpdating = False

For Each a In MyArr
    r.Add a, a
Next a
For i = 1 To r.Count
    With Range("G2")
        .Offset(i, 0) = r(i)
        .Offset(i, 1) = Application.WorksheetFunction.CountIf(DataRng1, r(i))
        .Offset(i, 2) = Application.WorksheetFunction.CountIf(DataRng2, r(i))
    End With
Next
Application.ScreenUpdating = True
End Sub

Open in new window

Noah

ASKER

The output looks like this now.

Can you edit the code so it will look like this instead

Saqib Husain

Sub GetArrayCount()

Dim Ws As Worksheet
Dim LRow As Long, i As Long
Dim r As New Collection, a
Dim DataRng1 As Range, DataRng2 As Range
Dim MyArr() As Variant

Set Ws = Worksheets("Sheet1")
LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row
Set DataRng1 = Ws.Range("D2:D" & LRow)
Set DataRng2 = Ws.Range("E2:E" & LRow)
MyArr = Array("Average", "Excellent", "Good", "Poor")

Application.ScreenUpdating = False

For Each a In MyArr
    r.Add a, a
Next a
With Range("G2")
    .Offset(0, 1) = "Question 2"
    .Offset(0, 2) = "Question 3"
    For i = 1 To r.Count
            .Offset(i, 0) = r(i)
            .Offset(i, 1) = Application.WorksheetFunction.CountIf(DataRng1, r(i))
            .Offset(i, 2) = Application.WorksheetFunction.CountIf(DataRng2, r(i))
    Next
End With
Application.ScreenUpdating = True
End Sub

Open in new window

Noah

ASKER

Okay thank you very much! :)

I will leave the thread open for a while longer to see if there is any other solutions.

Saqib Husain

I do not understand. What do you mean by other solutions?

If there is something else you should mention it. If there is nothing else then you should close the question.

Saqib Husain

Do you want the bar chart also to be coded?

Noah

ASKER

It would be great if you can code the bar chart too! :)

And I meant to keep it open to see if there are any other methods or code variations

ASKER CERTIFIED SOLUTION

Saqib Husain

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Noah