Updating Macro Troubles

Question

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 column is removed. I now have to make the macro more dynamic.

Here's the current code:

Sub CreateAllGradeMap()
    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,"","""")&IF(RC[13]>0,""4,"","""")&IF(RC[16]>0,""5,"","""")&IF(RC[19]>0,""6,"","""")&IF(RC[22]>0,""7,"","""")&IF(RC[25]>0,""8,"","""")&IF(RC[28]>0,""9,"","""")&IF(RC[31]>0,""10,"","""")&IF(RC[34]>0,""11,"","""")&IF(RC[37]>0,""12,"","""")&IF(RC[40]>0,""13,"","""")"
    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,"","""")&IF(RC[13]>0,""4,"","""")&IF(RC[16]>0,""5,"","""")&IF(RC[19]>0,""6,"","""")&IF(RC[22]>0,""7,"","""")&IF(RC[25]>0,""8,"","""")&IF(RC[28]>0,""9,"","""")&IF(RC[31]>0,""10,"","""")&IF(RC[34]>0,""11,"","""")&IF(RC[37]>0,""12,"","""")&IF(RC[40]>0,""13,"","""")"
    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,"","""")&IF(RC[13]>0,""4,"","""")&IF(RC[16]>0,""5,"","""")&IF(RC[19]>0,""6,"","""")&IF(RC[22]>0,""7,"","""")&IF(RC[25]>0,""8,"","""")&IF(RC[28]>0,""9,"","""")&IF(RC[31]>0,""10,"","""")&IF(RC[34]>0,""11,"","""")&IF(RC[37]>0,""12,"","""")&IF(RC[40]>0,""13,"","""")"
    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

Here's an example of what it looks like after the macro is used. The green columns were inserted after the macro.


As you can see, if a column is removed (such as Math Grade 2), it would throw off the rest of the spreadsheet. My original thought process was to scan the columns to look for like values Math, Science, History. I worry about how it would impact performance though. Any help would be greatly appreciated.