VBABeginer_Chappers
New Member
- Joined
- Mar 8, 2018
- Messages
- 10
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
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