I have a drop down list of different car models and need to assign stock numbers to them. This has been working for years, but we've added a new model and none of them automatically assigns the next available stock number anymore. Any help is appreciated. Thanks
Here's the existing code for Module 1
Sub Increment_ModelNumber()
Dim ModelName As String
Dim ModelNum As String
Dim Prefix As String
Dim Suffix As String
ModelName = ActiveCell.Offset(0, 1).Value
ModelNum = Names(ModelName).Value
Prefix = Mid(ModelNum, 3, InStr(1, ModelNum, "-") - 2)
Suffix = Val(Mid(ModelNum, InStr(1, ModelNum, "-") + 1, 4)) + 1
Do Until Len(Suffix) = 4
Suffix = "0" & Suffix
Loop
ActiveCell.Value = Prefix & Suffix
Names(ModelName).Value = "=" & Chr(34) & Prefix & Suffix & Chr(34)
End Sub
Sheet 1 (code)
Private Sub Worksheet_Change(ByVal Target As Range)
If InStr(1, Selection.Address, ":") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column <> 2 Then Exit Sub
Application.EnableEvents = False
With Target(1, 4)
.Value = Date
.EntireColumn.AutoFit
End With
Target.Offset(0, -1).Select
Increment_ModelNumber
Target.Offset(0, 1).Select
Application.EnableEvents = True
End Sub
Here's the existing code for Module 1
Sub Increment_ModelNumber()
Dim ModelName As String
Dim ModelNum As String
Dim Prefix As String
Dim Suffix As String
ModelName = ActiveCell.Offset(0, 1).Value
ModelNum = Names(ModelName).Value
Prefix = Mid(ModelNum, 3, InStr(1, ModelNum, "-") - 2)
Suffix = Val(Mid(ModelNum, InStr(1, ModelNum, "-") + 1, 4)) + 1
Do Until Len(Suffix) = 4
Suffix = "0" & Suffix
Loop
ActiveCell.Value = Prefix & Suffix
Names(ModelName).Value = "=" & Chr(34) & Prefix & Suffix & Chr(34)
End Sub
Sheet 1 (code)
Private Sub Worksheet_Change(ByVal Target As Range)
If InStr(1, Selection.Address, ":") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column <> 2 Then Exit Sub
Application.EnableEvents = False
With Target(1, 4)
.Value = Date
.EntireColumn.AutoFit
End With
Target.Offset(0, -1).Select
Increment_ModelNumber
Target.Offset(0, 1).Select
Application.EnableEvents = True
End Sub