VBA Count add to Sheet2

anthonyexcel

Active Member
Joined
Jun 10, 2011
Messages
258
Office Version
  1. 365
Platform
  1. Windows
I have about 40,000 rows of data on sheet1 like below. What I need to do is to give a summary of grade level on sheet2. Please see below data.
<style type="text/css">
table.tableizer-table {
font-size: 12px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>

GradeTest Level#
3
117
210
36
4
120
28
33
5
114
29
316
6
116
211
36
7
118
211
35
8
118
213
33
3
116
210
35
4
115
217
34

<tbody>
</tbody>


So that the data looks like this:


GradeTest Level#
3133
220
311
4135
225
37
5114
29
316
6116
211
36
7118
211
35
8118
213
33

<tbody>
</tbody>
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
You can transform your original table with Power Query,

Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Fill = Table.FillDown(Source,{"Grade"}),
    Filter = Table.SelectRows(Fill, each ([Test Level] <> null)),
    Group = Table.Group(Filter, {"Grade", "Test Level"}, {{"Total", each List.Sum([#"#"]), type number}})
in
    Group

This doesn't have the blank rows below the Grade values like in your example, it goes 1,1,1,2,2,2,etc. But after you've done the PQ transform, you adjust the visuals by turning the result into a pivot table.
 
Upvote 0
I used Power Query to get the data in a form that I could then create a pivot table.

Here is the Mcode for the data rearranging

Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Grade", Int64.Type}, {"Test Level", Int64.Type}, {"#", Int64.Type}}),
    #"Filled Down" = Table.FillDown(#"Changed Type",{"Grade"}),
    #"Filtered Rows" = Table.SelectRows(#"Filled Down", each ([Test Level] <> null))
in
    #"Filtered Rows"

Here is what the data looks like and then pivotted.

vABCDEFG
1GradeTest Level#
23117
33210GradeTest LevelSum of #
43363
54120133
6428220
7433311
851144
9529135
105316225
11611637
1262115
13636114
14711829
157211316
167356
178118116
188213211
1983336
2031167
213210118
22335211
23411535
2442178
25434118
26213
2733
28
 
Upvote 0
Here's a VBA solution as well. This will output the results beginning in column J. You can adjust that bit of code to put the results where you want them.

Code:
Sub MXL201907202()
Dim AR() As Variant: AR = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim tmp As String, grade As String
Dim Last As Long: Last = 0

For a = LBound(AR) + 1 To UBound(AR)
    If Not IsEmpty(AR(a, 1)) Then AL.Add a
Next a

For i = 0 To AL.Count - 1
    grade = AR(AL(i), 1)
    If i < AL.Count - 1 Then Last = AL(i + 1) - 1 Else Last = UBound(AR)
    For j = AL(i) + 1 To Last
        tmp = grade & "-" & AR(j, 2)
        SD(tmp) = SD(tmp) + AR(j, 3)
    Next j
Next i

Range("J1:K1") = Array("Grade-Level", "Total")

With Range("J2").Resize(SD.Count, 1)
    .Value = Application.Transpose(SD.keys)
    .Offset(, 1).Value = Application.Transpose(SD.items)
End With

With Range("J1").CurrentRegion
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
End With

End Sub
 
Last edited:
Upvote 0
Thank you both!!! Amazing!! Did exactly what I needed it to do! Thanks again!
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,148
Members
448,552
Latest member
WORKINGWITHNOLEADER

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