locked
Updating Macro Troubles RRS feed

  • 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.



    • Edited by Lanmanna Friday, November 13, 2020 6:18 PM
    Friday, November 13, 2020 6:16 PM