VBA Count add to Sheet2

anthonyexcel

Board Regular
Joined
Jun 10, 2011
Messages
218
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>
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,758
Office Version
365, 2019, 2016
Platform
Windows
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.
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,580
Office Version
2019
Platform
Windows
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
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,758
Office Version
365, 2019, 2016
Platform
Windows
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:

Watch MrExcel Video

Forum statistics

Threads
1,099,472
Messages
5,468,823
Members
406,611
Latest member
hanman453

This Week's Hot Topics

Top