Private Sub NewRowButton_Click()
With Sheets("HONDA SHEET")
.Range("A17").EntireRow.Insert Shift:=xlDown
.Range("A17:G18").Borders.Weight = xlThin
.Range("G17").Value = Date
.Range("A13").Interior.ColorIndex = 2
Range("C1:F12").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A17").Select
End With
End Sub
Private Sub CheckButton_Click()
HondaParts.Show
End Sub
Private Sub VinToolButton_Click()
ActiveWorkbook.FollowHyperlink Address:="http://www.vindecoderz.com/EN/Honda", NewWindow:=True
End Sub
Private Sub Worksheet_Activate()
Range("A13").Select
ActiveWindow.ScrollRow = 14
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Sheets("HONDA SHEET")
If Not Intersect(Target, .Range("A13")) Is Nothing And .Range("A13") <> "" Then
If Len(.Range("A13").Value) <> 17 Then
.Range("A13").Interior.ColorIndex = 3
MsgBox ("Honda Chassis Number Must Be 17 Characters, Please Try Again")
.Range("A13").ClearContents
.Range("A13").Interior.ColorIndex = 2
.Range("A13").Activate
Else
Application.EnableEvents = False
.Rows(17).Insert Shift:=xlDown
.Range("A17:G17").Borders.Weight = xlThin
.Range("G17").Value = Date
.Range("A17").Value = UCase(.Range("A13").Value)
.Range("B17").Select
.Range("A13").ClearContents
.Range("A17").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
Application.EnableEvents = True
End If
End If
End With
Target.Interior.ColorIndex = 6
If Not Intersect(Target, Range("F17")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Value = "ACCORD ID 48" Then Range("D1").Value = Range("D1").Value + 1
If Target.Value = "ACCORD ID 8E" Then Range("D2").Value = Range("D2").Value + 1
If Target.Value = "BLACK NRK ID 46" Then Range("D3").Value = Range("D3").Value + 1
If Target.Value = "BLACK NRK ID 48" Then Range("D4").Value = Range("D4").Value + 1
If Target.Value = "BLACK NRK ID 8E" Then Range("D5").Value = Range("D5").Value + 1
If Target.Value = "CIVIC CE0523" Then Range("D6").Value = Range("D6").Value + 1
If Target.Value = "CRV HLIK-1T" Then Range("D7").Value = Range("D7").Value + 1
If Target.Value = "CRV ID 48" Then Range("D8").Value = Range("D8").Value + 1
If Target.Value = "FLIP REMOTE 2B" Then Range("D9").Value = Range("D9").Value + 1
If Target.Value = "FLIP REMOTE 3B" Then Range("D10").Value = Range("D10").Value + 1
If Target.Value = "FRV ID 48" Then Range("D11").Value = Range("D11").Value + 1
If Target.Value = "FRV ID 8E" Then Range("D12").Value = Range("D12").Value + 1
If Target.Value = "G8D-345H-A" Then Range("D13").Value = Range("D13").Value + 1
If Target.Value = "G8D-348H-A" Then Range("F1").Value = Range("F1").Value + 1
If Target.Value = "G8D-350H-A" Then Range("F2").Value = Range("F2").Value + 1
If Target.Value = "G8D-453H-A" Then Range("F3").Value = Range("F3").Value + 1
If Target.Value = "G8D-456H-A" Then Range("F4").Value = Range("F4").Value + 1
If Target.Value = "HON 58 ID 13" Then Range("F5").Value = Range("F5").Value + 1
If Target.Value = "HON 58 ID 48" Then Range("F6").Value = Range("F6").Value + 1
If Target.Value = "JAZZ HLIK-1T" Then Range("F7").Value = Range("F7").Value + 1
If Target.Value = "JAZZ ID 48" Then Range("F8").Value = Range("F8").Value + 1
If Target.Value = "JAZZ ID 8E" Then Range("F9").Value = Range("F9").Value + 1
If Target.Value = "LEGEND ID 8E" Then Range("F10").Value = Range("F10").Value + 1
If Target.Value = "SILVER NRK ID 48" Then Range("F11").Value = Range("F11").Value + 1
If Target.Value = "SILVER NRK ID 8E" Then Range("F12").Value = Range("F12").Value + 1
If Target.Value = "72147-S2H-G01" Then Range("F13").Value = Range("F13").Value + 1
End If
If Target.Address = "$F$17" Then
Call sheettolist
End If
[COLOR=#ff0000]'New part[/COLOR]
If Not Intersect(Target, Range("B13")) Is Nothing Then
If UCase(Target.Value) = "A" Then Target.Value = "2010"
If UCase(Target.Value) = "B" Then Target.Value = "2011"
If UCase(Target.Value) = "D" Then Target.Value = "2012"
If UCase(Target.Value) = "E" Then Target.Value = "2013"
If UCase(Target.Value) = "F" Then Target.Value = "2014"
If UCase(Target.Value) = "G" Then Target.Value = "2015"
If UCase(Target.Value) = "H" Then Target.Value = "2016"
If UCase(Target.Value) = "I" Then Target.Value = "2017"
If UCase(Target.Value) = "J" Then Target.Value = "2018"
If UCase(Target.Value) = "K" Then Target.Value = "2019"
End If
[COLOR=#ff0000]'End new part[/COLOR]
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myStartCol As String
Dim myEndCol As String
Dim myStartRow As Long
Dim myLastRow As Long
Dim myRange As Range
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' *** Specify columns to apply this to ***
myStartCol = "A"
myEndCol = "G"
' *** Specify start row ***
myStartRow = 17
' Use first column to find the last row
myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
' Build range to apply this to
Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
' Clear the color of all the cells in range
myRange.Interior.ColorIndex = 6
' Check to see if cell selected is outside of range
If Intersect(Target, myRange) Is Nothing Then Exit Sub
' Highlight the row and column that contain the active cell
Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
Target.Interior.Color = vbGreen
Application.ScreenUpdating = True
End Sub