Sub CreateType8()
Application.ScreenUpdating = False 'Turns Screen Updating off so macro can run faster
'Copy and Insert Type
Rows("409:448").Select
Selection.Copy
Rows("450:450").Select
Selection.Insert
'This code finds the copied Return To Top and Add Type rectangles and changes their colors and assigns _
a macro to the Add Type rectangle
Dim shape_count, rect_count, num_rect As Integer
shape_count = 0
num_rect = 0
'find last Return To Top rectangle
For Each oShape In ActiveSheet.Shapes
If oShape.Name = "Return To Top" Then
rect_count = shape_count
num_rect = num_rect + 1
End If
shape_count = shape_count + 1
Next
'change last Return To Top rectangle
shape_count = 0
For Each oShape In ActiveSheet.Shapes
If shape_count = rect_count Then
With oShape.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
.Solid
End With
Exit For
End If
shape_count = shape_count + 1
Next
'Make the same changes to Add Type Rectangle
shape_count = 0
num_rect = 0
'find last Add Type rectangle
For Each oShape In ActiveSheet.Shapes
If oShape.Name = "Add Type" Then
rect_count = shape_count
num_rect = num_rect + 1
End If
shape_count = shape_count + 1
Next
'change last Add Type rectangle
shape_count = 0
For Each oShape In ActiveSheet.Shapes
If shape_count = rect_count Then
With oShape.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
.Solid
End With
Exit For
End If
shape_count = shape_count + 1
Next
'apply macro to Add Type rectangle
shape_count = 0
For Each oShape In ActiveSheet.Shapes
If shape_count = rect_count And oShape.Name = "Add Type" Then
With oShape
.OnAction = "TimeToMakeTheMacros"
End With
Exit For
End If
shape_count = shape_count + 1
Next
'Code below changes background colors to distinguish between types'
'Color Line Concept Section'
Range("B453:AZ453").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
'Color Cost Estimate Section'
Range("AD452:AZ453").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
'Color Skinny Strip between Cycle Time and Cost Table'
Range("AD454:AD489").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
'Color Weld Section'
Range("B481:AD481").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("B481:B489").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("C481:D485").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("E485:AD485").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("V482:AD484").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AA486:AD489").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("C489:Z489").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("I486:U488").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
'Color Skinny Strip Right of Cost Table'
Range("AZ454:AZ489").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
'Color Cycle Time Details
Range("BQ451:HH451").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If Not Intersect(Range("B454:AA480"), sh.TopLeftCell) Is Nothing And _
Not Intersect(Range("B454:AA480"), sh.BottomRightCell) Is Nothing Then
sh.Delete
End If
Next sh
'Deleting any pre-existing cost data
Range("AE456:AE478").Select
Selection.ClearContents
Range("AV456:AV478").Select
Selection.ClearContents
'Deleting any pre-existing cycle time data
Range("BR453:BS468").Select
Selection.ClearContents
Range("BT454:BU468").Select
Selection.ClearContents
Range("CM453:CN468").Select
Selection.ClearContents
Range("CO454:CP468").Select
Selection.ClearContents
Range("DH453:DI468").Select
Selection.ClearContents
Range("DJ454:DK468").Select
Selection.ClearContents
Range("EC453:ED468").Select
Selection.ClearContents
Range("EE454:EF468").Select
Selection.ClearContents
Range("EX453:EY468").Select
Selection.ClearContents
Range("EZ454:FA468").Select
Selection.ClearContents
Range("FS453:FT468").Select
Selection.ClearContents
Range("FU454:FV468").Select
Selection.ClearContents
Range("GN453:GO468").Select
Selection.ClearContents
Range("GP454:GQ468").Select
Selection.ClearContents
Range("BR472:BS487").Select
Selection.ClearContents
Range("BT473:BU487").Select
Selection.ClearContents
Range("CM472:CN487").Select
Selection.ClearContents
Range("CO473:CP487").Select
Selection.ClearContents
Range("DH472:DI487").Select
Selection.ClearContents
Range("DJ473:DK487").Select
Selection.ClearContents
Range("EC472:ED487").Select
Selection.ClearContents
Range("EE473:EF487").Select
Selection.ClearContents
Range("EX472:EY487").Select
Selection.ClearContents
Range("EZ473:FA487").Select
Selection.ClearContents
Range("FS472:FT487").Select
Selection.ClearContents
Range("FU473:FV487").Select
Selection.ClearContents
Range("GN472:GO487").Select
Selection.ClearContents
Range("GP473:GQ487").Select
Selection.ClearContents
'The following code fixes the data validation problem that happens when the rows are copy and pasted
Range("BR453,CM453,DH453,EC453,EX453,FS453,GN453,BR472,CM472,DH472,EC472,EX472,FS472,GN472") = "Associate"
'First Row of Cycle Time Entry Boxes
Range("BR454").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($BR$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("BR455:BR468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("BR453") = ""
Range("CM454").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($CM$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("CM455:CM468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("CM453") = ""
Range("DH454").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($DH$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("DH455:DH468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("DH453") = ""
Range("EC454").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($EC$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("EC455:EC468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("EC453") = ""
Range("EX454").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($EX$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("EX455:EX468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("EX453") = ""
Range("FS454").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($FS$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("FS455:FS468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("FS453") = ""
Range("GN454").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($GN$453,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("GN455:GN468").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("GN453") = ""
'Second Row of Cycle Time Entry Boxes
Range("BR473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($BR$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("BR474:BR487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("BR472") = ""
Range("CM473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($CM$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("CM474:CM487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("CM472") = ""
Range("DH473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($DH$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("DH474:DH487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("DH472") = ""
Range("EC473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($EC$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("EC474:EC487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("EC472") = ""
Range("EX473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($EX$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("EX474:EX487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("EX472") = ""
Range("FS473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($FS$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("FS474:FS487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("FS472") = ""
Range("GN473").Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(SUBSTITUTE($GN$472,"" "",""_""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Selection.Copy
Range("GN474:GN3487").Select
Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("GN472") = ""
'Comp Summary Sheet data goes down one row at a time so this must be done to get the right data _
into these cells'
Range("O450") = "='Comp Summary Sheet'!G13" 'Comp Information Type 7
Range("AJ450") = "='Comp Summary Sheet'!P13" 'Revision Level Number
Range("AL450") = "='Comp Summary Sheet'!Q13" 'Revision Level Date
Range("AQ450") = "='Comp Summary Sheet'!S13" 'Comment
Range("AX450") = "='Comp Summary Sheet'!W13" 'F REV
'Puts Type Name into Line Process Box: this way we can keep it open for manual entry
Range("AE80") = "=E451"
'Brings viewing area to the top left portion of the type'
Application.Goto Reference:="R449C1", Scroll:=True
Application.ScreenUpdating = True 'Turns Screen Updating back on
End Sub