Thanks
Code: Select all
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim c As Range, a
If Target.Address = "$K$8" Then
' Don't edit the cell
Cancel = True
' Increment the invoice nunber
Set c = Sheets("CHIT5&6").Range("J8")
c.NumberFormat = "@"
If InStr(c, "-") = 0 Then
c = "000001-" & Format(Date, "yy")
Else
a = Split(c, "-")
a(0) = Format(a(0) + 1, "00000#")
If Format(a(1), "00") <> Format(Date, "yy") Then a(1) = Format(Date, "yy")
c = Join(a, "-")
End If
Set c = Sheets("CHIT3&4").Range("J8")
c.NumberFormat = "@"
If InStr(c, "-") = 0 Then
c = "000001-" & Format(Date, "yy")
Else
a = Split(c, "-")
a(0) = Format(a(0) + 1, "00000#")
If Format(a(1), "00") <> Format(Date, "yy") Then a(1) = Format(Date, "yy")
c = Join(a, "-")
End If
'
Set c = Sheets("CHIT1&2").Range("J8")
c.NumberFormat = "@"
If InStr(c, "-") = 0 Then
c = "000001-" & Format(Date, "yy")
Else
a = Split(c, "-")
a(0) = Format(a(0) + 1, "00000#")
If Format(a(1), "00") <> Format(Date, "yy") Then a(1) = Format(Date, "yy")
c = Join(a, "-")
End If
End If
End Sub