VBA Autofill

[joshrescue62]

Hi all,

This is probably something pretty easy, I'm just not at all familiar with vba.

I have a grade book that I am using for my class this semester. I have entered in it my 15 students names, with each of there 5 test scores in columns (B3:F3) and class average in column (G3). I would like to create a macro that will insert a column in between F3 (the 5th test) and the Class average (G3), since there will be other tests I would like to input into this spreadsheet. I would like the heading to autofill from cell F3 (Test 5), and I would like it to say (Test 6) in G3. I would also like this macro to insert holding 0's in the new column (G) inserted for rows 4:19.

If anyone could help me out, it would definitely be very appreciated.

I hope this isn't too complex . If you need more information or pictures, let me know.

Thanks,
Josh

 

[j_harr]

Create a new copy of your workbook and try this out:

Sub Add_Test()
    'vars
        Dim i As Integer, RefCol As Integer, ColLetter As String
    With Range("A3").End(xlToRight)
        RefCol = .Column
        If .Column > 26 Then
            ColLetter = Chr(Int((.Column - 1) / 26) + 64) & Chr(((.Column - 1) Mod 26) + 65)
        Else
            ColLetter = Chr(.Column + 64)
        End If
    'insert new column
        .EntireColumn.Insert
    'test #
        .Offset(0, -1).Value = "Test " & Right(Range("A3").End(xlToRight), 1) + 1
    End With
    'adjust formulas and place 0s
        For i = 4 To 19
            Cells(i, RefCol + 1).Formula = _
                "=AVERAGE($B" & i & ":" & ColLetter & i & ")"
            Cells(i, RefCol).Value = 0
        Next i
End Sub

Adds the next test in row 3, adjusts all the average formulas from rows 4 to 19.

 

[j_harr]

Disregard the previous post, I wrote the test number code incorrectly. This works correctly:

Sub Add_Test()
    'vars
        Dim i As Integer, RefCol As Integer, ColLetter As String
    With Range("A3").End(xlToRight)
        RefCol = .Column
        If .Column > 26 Then
            ColLetter = Chr(Int((.Column - 1) / 26) + 64) & Chr(((.Column - 1) Mod 26) + 65)
        Else
            ColLetter = Chr(.Column + 64)
        End If
    'insert new column
        .EntireColumn.Insert
    'test #
        .Offset(0, -1).Value = "Test " & Replace(Range("A3").End(xlToRight), "Test ", "") + 1
    End With
    'adjust formulas and place 0s
        For i = 4 To 19
            Cells(i, RefCol + 1).Formula = _
                "=AVERAGE($B" & i & ":" & ColLetter & i & ")"
            Cells(i, RefCol).Value = 0
        Next i
End Sub

 

[joshrescue62]

hey thanks for your reply,

however when I run this code, it inserts 3 columns with headings Test 5, Test 6, and Test 7, in the incorrect place. It inserts them after column J, and I would like them to be inserted before column G. The 0's inserted are perfect, however I only need this macro to insert 1 column with heading Test 6, with 0's as placeholders.

Thanks so much for your help,

Josh

 

[j_harr]

You ran the code once and it inserted 3 new test columns?

 

[joshrescue62]

yes, it inserted 3 new test columns, and not in the correct location

 

[j_harr]

This is what I get when I run the code:
Before:

[TABLE="width: 448"]
<tbody>[TR]
[TD]

Name​

[/TD]
[TD]

Test 1​

[/TD]
[TD]

Test 2​

[/TD]
[TD]

Test 3​

[/TD]
[TD]

Test 4​

[/TD]
[TD]

Test 5​

[/TD]
[TD]

Average​

[/TD]
[/TR]
[TR]
[TD]

Johnny​

[/TD]
[TD="align: right"]

41​

[/TD]
[TD="align: right"]

66​

[/TD]
[TD="align: right"]

36​

[/TD]
[TD="align: right"]

26​

[/TD]
[TD="align: right"]

91​

[/TD]
[TD="align: right"]

52​

[/TD]
[/TR]
[TR]
[TD]

Sally​

[/TD]
[TD="align: right"]

81​

[/TD]
[TD="align: right"]

86​

[/TD]
[TD="align: right"]

50​

[/TD]
[TD="align: right"]

35​

[/TD]
[TD="align: right"]

46​

[/TD]
[TD="align: right"]

59.6​

[/TD]
[/TR]
</tbody>[/TABLE]
...

After:

[TABLE="width: 512"]
<tbody>[TR]
[TD]

Name​

[/TD]
[TD]

Test 1​

[/TD]
[TD]

Test 2​

[/TD]
[TD]

Test 3​

[/TD]
[TD]

Test 4​

[/TD]
[TD]

Test 5​

[/TD]
[TD]

Test 6​

[/TD]
[TD]

Average​

[/TD]
[/TR]
[TR]
[TD]

Johnny​

[/TD]
[TD="align: right"]

41​

[/TD]
[TD="align: right"]

66​

[/TD]
[TD="align: right"]

36​

[/TD]
[TD="align: right"]

26​

[/TD]
[TD="align: right"]

91​

[/TD]
[TD="align: center"]
0[/TD]
[TD="align: right"]

43.33333​

[/TD]
[/TR]
[TR]
[TD]

Sally​

[/TD]
[TD="align: right"]

81​

[/TD]
[TD="align: right"]

86​

[/TD]
[TD="align: right"]

50​

[/TD]
[TD="align: right"]

35​

[/TD]
[TD="align: right"]

46​

[/TD]
[TD="align: right"]

0
​

[/TD]
[TD="align: right"]

49.66667​

[/TD]
[/TR]
</tbody>[/TABLE]

...

 

[j_harr]

Extra columns: I have no idea how or why the code would insert more than one row, there's only one insert in there. Can you paste the code you've got in the module?

Wrong place: That would happen if there's data in the cells of row 3 immediately following the Average cell. IE: Average is in cell G3, cell H3 contains "Favorite Color". Is that the case?

 

[joshrescue62]

Hey,

Ive attached two copies of my spreadsheet, one that is the original, and the other that includes yellow highlighting of exactly what I would like this macro to do. I'm sorry if this has been confusing

original- js | Stuff to Buy
what i want macro to do -js | Stuff to Buy

Sorry about the Weird hyperlink names, just check them out they are pictures on a random pintrest acct, lol

Josh

 

[j_harr]

I've altered the code so it specifically finds the cell containing "Average" and then adds the column in front of that, give this a try:

Sub Add_Test()
    'vars
        Dim i As Integer, RefCol As Integer, ColLetter As String
        RefCol = Range(Cells(3, 1), Cells(3, Range("A3").End(xlToRight).Column)).Find(What:="Average", LookIn:=xlValues, LookAt:=xlWhole).Column
        If RefCol > 26 Then
            ColLetter = Chr(Int((RefCol - 1) / 26) + 64) & Chr(((RefCol - 1) Mod 26) + 65)
        Else
            ColLetter = Chr(RefCol + 64)
        End If
    'insert new column
        Cells(3, RefCol).EntireColumn.Insert
    'test #
        Cells(3, RefCol).Value = "Test " & Replace(Cells(3, RefCol - 1), "Test ", "") + 1
    'adjust formulas and place 0s
        For i = 4 To 19
            Cells(i, RefCol + 1).Formula = _
                "=AVERAGE($B" & i & ":" & ColLetter & i & ")"
            Cells(i, RefCol).Value = 0
        Next i
End Sub