Insert column to left on button click and copy formula

[auroralily]

Hi,

I want to use excel to plot a graph of student grades but the grades are alphanumeric or strings so excel won't plot as is.

I have create 2 sheets as so:

Sheet 1

Student Y7 PC3 Y8 PC1 Y8 PC2 Y8 PC3 Y9 PC1 Y9 PC2 btn btn btn btn btn btn 5H 6L 6S 6H 7L 7S <tbody> </tbody> Sheet 2 Student Y7 PC3 Y8 PC1 Y8 PC2 Y8 PC3 Y9 PC1 Y9 PC2 13 14 15 16 17 18 <tbody> </tbody>

<colgroup><col><col><col><col><col span="7"><col span="5"><col></colgroup><tbody>
</tbody>

The cells in the first row contain the simple =Sheet1cell code.
The cells in the second row of sheet 2 will contain either nested if statements or a macro function to convert the grades from sheet 1 to a number in the same cell in sheet 2.

These examples contain the end of term target data that is generated at the beginning of the year. When the students take a test a column is inserted to the left and the data inputted.

What I want the spreadsheet to be able to do:

• I click the btn in a column on sheet 1 (eg the column with header Y8 PC2)
• A blank column is inserted in sheet 1 to the left of that column (eg to the left of column Y8 PC2)
• A column is also inserted in sheet 2 to the left of the equivalent column (eg to the left of column Y8 PC2 in sheet 2)
• The new column in sheet 2 needs have all the formulas copied from the column to the right (eg formulas from column Y8 PC2)

Is this possible and how would I go about coding it?

Thanks

 

[Snakehips]

auroralily,

Welcome to MrExcel.

Perhaps, rather than have a button for each column, you have a single button?
The code below requires that you select the cell in row 1 that is to the right of where you wish to insert the column.

Sub Insert_Col()
Set ws1 = Sheets("Sheet1") '****edit sheet name to suit
Set ws2 = Sheets("Sheet2") '*****edit sheet name to suit
If Not ActiveSheet.Name = ws1.Name Then Exit Sub
If Not ActiveCell.Row = 1 Then Exit Sub 'requires cell in row 1 to be selected to identify insert column
If MsgBox("Please confirm that you wish to insert a new column to left of selection?", vbYesNo, "Just Checking!") = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveCell.EntireColumn.Columns.Insert
c = ActiveCell.Column
With ws2
.Select
.Columns(c).Copy
.Columns(c).Insert
ws1.Select
End Sub

[code]

Copy the code to either a code module or Sheet1's code module (Right click sheet tab >> View Code >> Paste into code pane)

Hope that helps.

 

[auroralily]

Hi,

Thanks for that - I added the code and inserted a row for the button to live so changed the ActiveCell.Row to 2 but I got this error:


Does the End With statement go before ws1.select?

Thanks

 

[Snakehips]

Appologies, careless mistake by me.

Sub Insert_Col()
Set ws1 = Sheets("Data") '****edit sheet name to suit
Set ws2 = Sheets("GraphData") '*****edit sheet name to suit
If Not ActiveSheet.Name = ws1.Name Then Exit Sub
If Not ActiveCell.Row = 2 Then Exit Sub 'requires cell in row 1 to be selected to identify insert column
If MsgBox("Please confirm that you wish to insert a new column to left of selection?", vbYesNo, "Just Checking!") = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveCell.EntireColumn.Columns.Insert
c = ActiveCell.Column
With ws2
.Select
.Columns(c).Copy
.Columns(c).Insert
ws1.Select
Application.CutCopyMode = False  ' <  Have also added this to get rid of 'marching ants' copy selection<have added="" this="" also,="" to="" get="" rid="" of="" 'marching="" ants'<="" font="">
End With
</have><have added="" this="" also,="" to="" get="" rid="" of="" 'marching="" ants'<="" font="">End Sub

</have><have added="" this="" also,="" to="" get="" rid="" of="" 'marching="" ants'<="" font=""></have>

 

[auroralily]

That did it - works perfectly, thanks.

 

[auroralily]

Hi,

Sorry to be a pain - your code worked brilliantly but in order to get the graph to do what I need it to I have had to add another sheet. I have duplicated the code section so the new sheet also adds a column in the correct place but on this sheet I only want formula copied in row 1, not the entire column as I need the blank cells to make my base line plot correctly.

This is my code so far:

Sub New_Column()
Set ws1 = Sheets("Data") '****edit sheet name to suit
Set ws2 = Sheets("GraphData") '*****edit sheet name to suit
Set ws3 = Sheets("TargetData")
If Not ActiveSheet.Name = ws1.Name Then Exit Sub
If Not ActiveCell.Row = 2 Then Exit Sub 'requires cell in row 1 to be selected to identify insert column
If MsgBox("Please confirm that you wish to insert a new column to left of selection?", vbYesNo, "Just Checking!") = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveCell.EntireColumn.Columns.Insert
c = ActiveCell.Column
With ws2
.Select
.Columns(c).Copy
.Columns(c).Insert
ws1.Select
Application.CutCopyMode = False  ' <
End With
With ws3
.Select
.Columns(c).Copy
.Columns(c).Insert
ws1.Select
Application.CutCopyMode = False  ' <
End With
End Sub

What do I need to change to make ws3 only copy the formula in row 1? I'm using Excel 2007.

Thanks you for all of your help.

 

[Snakehips]

Try this....

Sub New_Column()
Set ws1 = Sheets("Data") '****edit sheet name to suit
Set ws2 = Sheets("GraphData") '*****edit sheet name to suit
Set ws3 = Sheets("TargetData")
If Not ActiveSheet.Name = ws1.Name Then Exit Sub
If Not ActiveCell.Row = 2 Then Exit Sub 'requires cell in row 2 to be selected to identify insert column
If MsgBox("Please confirm that you wish to insert a new column to left of selection?", vbYesNo, "Just Checking!") = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveCell.EntireColumn.Columns.Insert
c = ActiveCell.Column
With ws2
.Select
.Columns(c).Copy  ' << Copy and insert column
.Columns(c).Insert
End With
With ws3
.Select
.Columns(c).Insert  '<< Insert column ( No copy)
.Cells(1, c + 1).Copy .Cells(1, c)  '<< copy row 1 cell
End With
ws1.Select
Application.CutCopyMode = False
End Sub

 

[auroralily]

Thank you so much - that works brilliantly

 

[Snakehips]

You are welcome.