Create New sheet and add VBA code

[VBABeginer_Chappers]

Hi

I have 2 bits of code which as individual codes work well however I have tried to join together with no success. I keep getting error 400.

My first bit of code creates a new sheet for every vehicle in a list on sheet (To Hide) for the year in-putted via an InputBox it then renames the sheet YYYY Vehicle Reg and then copies a table and creates a graph on each new sheet.

My second bit of code add's a Macro to the activesheet within the VBA Project that changes the tab colour when cell B1 changes.

The amalgamation of the two codes should create the new sheets as with code 1 and then add the tab colour change macro to each new sheet Code 2.

Thank-you in advance for any help.

Sub New_year()


'------------------------------------------------
'Creates a new tab for every aircraft for an
'input year
'------------------------------------------------


Dim Newyear As String
Dim Vehicle As String
Dim CopyRow As Integer






Newyear = InputBox("Enter the New year", "What is the next Year?")


If Newyear = vbNullString Then Exit Sub




For CopyRow = 2 To 26


Vehicle = Sheets("To Hide").Cells(CopyRow, "C").Value


Sheets.Add after:=Sheets(Sheets.Count)

Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim S As String
Dim LineNum As Long

Set VBComp = ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)

Set CodeMod = VBComp.CodeModule
LineNum = CodeMod.CountOfLines + 1
S = "Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
"MyVal = Range(""B1"").Value" & vbCrLf & _
"With ActiveSheet.Tab" & vbCrLf & _
"Select Case MyVal" & vbCrLf & _
"Case Is = ""824""" & vbCrLf & _
".Color = vbRed" & vbCrLf & _
"Case Is = ""814""" & vbCrLf & _
".Color = vbGreen" & vbCrLf & _
"Case Is = ""820""" & vbCrLf & _
".Color = vbYellow" & vbCrLf & _
"Case Is = ""829""" & vbCrLf & _
".Color = vbBlue" & vbCrLf & _
"Case Is = ""MDMF""" & vbCrLf & _
".Color = vbBrown" & vbCrLf & _
"Case Is = ""Other""" & vbCrLf & _
".Color = vbWhite" & vbCrLf & _
"Case Else" & vbCrLf & _
".ColorIndex = xlColorIndexNone" & vbCrLf & _
"End Select" & vbCrLf & _
"End With" & vbCrLf & _
"End Sub"


CodeMod.InsertLines LineNum, S

ActiveSheet.Name = Newyear & " " & Vehicle


Sheets("To Hide").Select
Range("E1:AH28").Select
Selection.Copy
Sheets(Newyear & " " & Vehicle).Select
Range("A1").Select
ActiveSheet.Paste
Range("E1") = Newyear
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SetSourceData Source:=Range("B3:AD6")

Next CopyRow

End Sub


I'm hoping I have just put things in the wrong place.

Many thanks

Chappers

 

[John_w]

Instead of trying to generate the Worksheet_Change code for each added sheet, use the Workbook_SheetChange event in the ThisWorkbook module, which is what your requirement is designed for. The start of the code would be something like this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim MyVal As String
    If Sh.Name <> "To Hide" Then
        MyVal = Sh.Range("B1").Value
        With Sh.Tab

Please use CODE tags - the # icon in the message editor.

 

[VBABeginer_Chappers]

Many thanks for the quick reply.