Count ONLY numeric values?

[somedood]

Hi everyone. So one of my coworkers asked me to update a macro that she uses for checking to see what assignments students turned in. Previously, she had a specific template that was never edited; however, she now wants to be able to still run the macro if a specific column is removed or one is added (adding would be a nice to have, but not required). I now have to make the macro more dynamic. Here's an example of what I'm trying to accomplish with the macro.

Before the macro is run.

After the macro is run.

Again, the macro does work when columns aren't removed/added, but now she wants to have the ability to remove Math, History, and Science columns without issue. Right now, if a column is deleted, it would count whatever data is in column O. For example, if Science Grade 3 is removed, Finalized would be counted in Clark, Diana, and Bruce's Science counts. It's hard coded to only work for

Here's the current code:

Sub CreateMap()

Dim TempString As String
TempString = ""

Application.ScreenUpdating = False ' Ensure we aren't spamming the graphics engine

Dim TheLastRow As Long
TheLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

' Insert the columns for the Math, History and Science maps
Columns("G:G").Select
Selection.Insert Shift:=xlToRight ', CopyOrigin:=xlFormatFromLeftOrAbove

Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

' Insert the all-data-indicator formulas for the Math formats
Columns("G:G").Select
TempString = "IF(RC[4]>0,""1,"","""")&IF(RC[7]>0,""2,"","""")&IF(RC[10]>0,""3,"","""")"
Selection.FormulaR1C1 = "=IF(LEN(" + TempString + ") > 0, LEFT( " + TempString + ", LEN( " + TempString + " ) - 1 ), " + TempString + " )"
Columns("G:G").EntireColumn.AutoFit
Columns("G:G").Formula = Columns("G:G").Value
Range("G1").Select
ActiveCell.FormulaR1C1 = "Math Map"

' Insert the all-data-indicator formulas for the History formats
Columns("H:H").Select
TempString = "IF(RC[4]>0,""1,"","""")&IF(RC[7]>0,""2,"","""")&IF(RC[10]>0,""3,"","""")"
Selection.FormulaR1C1 = "=IF(LEN(" + TempString + ") > 0, LEFT( " + TempString + ", LEN( " + TempString + " ) - 1 ), " + TempString + " )"
Columns("H:H").EntireColumn.AutoFit
Columns("H:H").Formula = Columns("H:H").Value
Range("H1").Select
ActiveCell.FormulaR1C1 = "History Map"

' Insert the all-data-indicator formulas for the Science formats
Columns("I:I").Select
TempString = "IF(RC[4]>0,""1,"","""")&IF(RC[7]>0,""2,"","""")&IF(RC[10]>0,""3,"","""")"
Selection.FormulaR1C1 = "=IF(LEN(" + TempString + ") > 0, LEFT( " + TempString + ", LEN( " + TempString + " ) - 1 ), " + TempString + " )"
Columns("I:I").EntireColumn.AutoFit
Columns("I:I").Formula = Columns("I:I").Value
Range("I1").Select
ActiveCell.FormulaR1C1 = "Science Map"

' Draw borders around the maps, and shade/color the cells
Call HighlightAllGradeMaps(TheLastRow)

' Draw the legend at the top
Call DrawInstructions("AllGrade")

ActiveSheet.name = "All Grade Map"

' If we aren't already filtering, then turn it on
If ActiveSheet.AutoFilterMode = False Then
    [a3].Select
    Selection.AutoFilter
End If

Rows("1:1").Select
Selection.Activate
With Selection.Font
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
End With

Rows("1:1").Select
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
End With
ActiveWindow.FreezePanes = True

End Sub

My initial thought was to only look for numerical values, using isNumerical, but my macro crashes when I try. My other thought was to code the macro to only search rows that are underneath a specific column name that contains Math, History, or Science in the cell, but I haven't had any luck figuring out how to do that. Any help would greatly be appreciated. Thank you.

 

[maabadi]

For example, if Science Grade 3 is removed, Finalized would be counted in Clark, Diana, and Bruce's Science counts.

This means if Science Graded 3 removed then Result at Science column should be 1 for Clark, 1,2,3 for Diana & 1,1 for Bruce (because finalized is No)
Is it Right? If No, Please Describe.

 

[somedood]

This means if Science Graded 3 removed then Result at Science column should be 1 for Clark, 1,2,3 for Diana & 1,1 for Bruce (because finalized is No)
Is it Right? If No, Please Describe.

Hi, maabadi. So Finalized is getting counted regardless. It's the fact that there's text in the field, which would cause it to be counted in Column G (which shouldn't happen).

 

[somedood]

When the third Math, History, and Science columns are deleted, Finalized still gets counted. Here's what that looks like.

 

[Akuini]

Hi, @somedood
Could you post the data as table not as image? so I can copy the data to my worksheet. The best way is using XL2BB add-in or just copy your range in excel then paste in reply window.

 

[somedood]

Hi, @Akuini

Sure!

Before macro is run

First Name

Last Name

ID

Email

Phone

ClassID

Math Grade 1

History Grade 1

Science Grade 1

Math Grade 2

History Grade 2

Science Grade 2

Math Grade 3

History Grade 3

Science Grade 3

Finalized?

Clark

Kent

1​

13​

1​

1​

1​

Yes

Diana

Prince

2​

51​

1​

1​

1​

1​

1​

1​

1​

1​

1​

Yes

Bruce

Wayne

3​

21​

1​

1​

1​

No

After macro is run

First Name

Last Name

ID

Email

Phone

ClassID

Math

History

Science

Math Grade 1

History Grade 1

Science Grade 1

Math Grade 2

History Grade 2

Science Grade 2

Math Grade 3

History Grade 3

Science Grade 3

Finalized?

Clark

Kent

1​

13​

1, 2

3

1​

1​

1​

Yes

Diana

Prince

2​

51​

1, 2, 3

1, 2, 3

1, 2, 3

1​

1​

1​

1​

1​

1​

1​

1​

1​

Yes

Bruce

Wayne

3​

21​

1

2, 3

1​

1​

1​

No

After macro is run (when the last Math, History, and Science grade columns are removed).

First Name

Last Name

ID

Email

Phone

ClassID

Math

History

Science

Math Grade 1

History Grade 1

Science Grade 1

Math Grade 2

History Grade 2

Science Grade 2

Finalized?

Clark

Kent

1​

13​

1, 2, 3

1​

1​

Yes

Diana

Prince

2​

51​

1, 2, 3

1, 2

1, 2

1​

1​

1​

1​

1​

1​

Yes

Bruce

Wayne

3​

21​

3

1

2

1​

1​

No

 

[maabadi]

Try this:

Sub SumStGrades()
Dim i As Long, Lr As Long, j As Long, A As Long, Lc As Long, S As String, M As String, N As String, P As String, T As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
For j = 3 To Lc
If Cells(1, j).Value = "ClassID" Then
Cells(1, j + 1).Resize(, 3).EntireColumn.Insert
Cells(1, j + 1).Value = "Math"
Cells(1, j + 2).Value = "History"
Cells(1, j + 3).Value = "Science"
A = j + 1
GoTo ReSum
End If
Next j
ReSum:
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To Lr
M = ""
N = ""
P = ""
For j = 7 To Lc - 1
If Cells(i, j) <> "" Then
S = Left(Cells(1, j).Value, Application.WorksheetFunction.Find(" ", Cells(1, j).Value) - 1)
T = Right(Cells(1, j).Value, 1)
Select Case S
Case "Math"
If M = "" Then
M = T
Else
M = M & ", " & T
End If
Case "History"
If N = "" Then
N = T
Else
N = N & ", " & T
End If
Case "Science"
If P = "" Then
P = T
Else
P = P & ", " & T
End If
End Select
End If
Next j
Cells(i, A).Value = M
Cells(i, A + 1).Value = N
Cells(i, A + 2).Value = P
Next i

End Sub

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	First	Last	ID	Email	Phone	ClassID	Math	History	Science	Math Grade 1	History Grade 1	Science Grade 1	Math Grade 2	History Grade 2	Science Grade 2	Math Grade 3	History Grade 3	Science Grade 3	Finalized?
2	Clark	Kent	1			13	1, 2	3		1			1				1		Yes
3	Diana	Prince	2			15	1, 2, 3	1, 2, 3	1, 2, 3	1	1	1	1	1	1	1	1	1	Yes
4	Bruce	Wayne	3			21		1	2, 3		1				1			1	No
5
Sheet2