Count ONLY numeric values?

somedood

New Member
Joined
Mar 16, 2017
Messages
17
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.
3rkGo.png


After the macro is run.
yrN5S.png


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:
Excel Formula:
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.
 

Some videos you may like

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,645
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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

New Member
Joined
Mar 16, 2017
Messages
17
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).
 
Last edited:

somedood

New Member
Joined
Mar 16, 2017
Messages
17
When the third Math, History, and Science columns are deleted, Finalized still gets counted. Here's what that looks like.
1612453939337.png
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,962
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Mar 16, 2017
Messages
17
Hi, @Akuini

Sure!

Before macro is run
First NameLast NameIDEmailPhoneClassIDMath Grade 1History Grade 1Science Grade 1Math Grade 2History Grade 2Science Grade 2Math Grade 3History Grade 3Science Grade 3Finalized?
ClarkKent
1​
13​
1​
1​
1​
Yes
DianaPrince
2​
51​
1​
1​
1​
1​
1​
1​
1​
1​
1​
Yes
BruceWayne
3​
21​
1​
1​
1​
No

After macro is run
First NameLast NameIDEmailPhoneClassIDMathHistoryScienceMath Grade 1History Grade 1Science Grade 1Math Grade 2History Grade 2Science Grade 2Math Grade 3History Grade 3Science Grade 3Finalized?
ClarkKent
1​
13​
1, 23
1​
1​
1​
Yes
DianaPrince
2​
51​
1, 2, 31, 2, 31, 2, 3
1​
1​
1​
1​
1​
1​
1​
1​
1​
Yes
BruceWayne
3​
21​
12, 3
1​
1​
1​
No

After macro is run (when the last Math, History, and Science grade columns are removed).
First NameLast NameIDEmailPhoneClassIDMathHistoryScienceMath Grade 1History Grade 1Science Grade 1Math Grade 2History Grade 2Science Grade 2Finalized?
ClarkKent
1​
13​
1, 2, 3
1​
1​
Yes
DianaPrince
2​
51​
1, 2, 31, 21, 2
1​
1​
1​
1​
1​
1​
Yes
BruceWayne
3​
21​
312
1​
1​
No
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,645
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Try this:
VBA Code:
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
ABCDEFGHIJKLMNOPQRST
1FirstLastIDEmailPhoneClassIDMathHistoryScienceMath Grade 1History Grade 1Science Grade 1Math Grade 2History Grade 2Science Grade 2Math Grade 3History Grade 3Science Grade 3Finalized?
2ClarkKent1131, 23111Yes
3DianaPrince2151, 2, 31, 2, 31, 2, 3111111111Yes
4BruceWayne32112, 3111No
5
Sheet2
 

Watch MrExcel Video

Forum statistics

Threads
1,127,861
Messages
5,627,307
Members
416,239
Latest member
Counselor85027

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
Top