automatic increment of permit numbers

[arjan kooger]

I have a row with different permit numbers starting with H or C, i try try figure out if it is possible that if i select a H or C in the next empty cell in column C, that it automatically put the next C or H number in that cell.

This to make it easier and avoid typo.

Would this be possible with a Sub or a function?

 

[awoohaw]

You could try something like this based on what you type in the HOT/COLD column:
I think if you had this in a table it would automatically fill down, but if not you would have to drag the cell above down.

Book1
	A	B	C	D
1
2			C0000001	Cold
3			H0000001	Hot
4			C0000002	Cold
5			H0000002	Hot
6			H0000003	Hot
7			C0000003	Cold
8			C0000004	Cold
9			H0000004	Hot
10			C0000005	Cold
11			C0000006	Cold
12			C0000007	Cold
13			H0000005	Hot
14			H0000006	Hot
15			H0000007	Hot
16			H0000008	Hot
17			C0000008	Cold
18			H0000009	Hot
19			C0000009	Cold
20			H0000010	Hot
21			C0000010	Cold
Sheet2

Cell Formulas
Range	Formula
C2:C21	C2	=LET( Above,$C$1:$C1, Letter,LEFT(D2,1), List,FILTER(Above,LEFT(Above)=Letter,0),Nbrs,1*SUBSTITUTE(List,Letter,""), Output,Letter&TEXT(1+MAX(Nbrs),"0000000"),Output)

 

[kevin9999]

I think @awoohaw has given you a perfectly suitable solution, however I took a different approach to your problem. With the code below, if you enter just an H or a C in column B and press enter, the next sequential number for that letter will be entered automatically. The code goes in the worksheet code area of the sheet in question (right click the sheet tab name, select view code & paste the code in the window that appears on the right of screen). Assumes your sequential numbers are in column B and that the first is in row 2.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        If Target.Column = 2 And (UCase(Target) = "H" Or UCase(Target) = "C") Then
            On Error GoTo Escape
            Application.EnableEvents = False
            Dim s As String, i As Long, j As Long, a
            s = UCase(Target)
            a = Range("B2", Target.Offset(-1))
            For i = LBound(a, 1) To UBound(a, 1)
                If UCase(Left(a(i, 1), 1)) = s Then
                    If CInt(Right(a(i, 1), 7)) > j Then j = CInt(Right(a(i, 1), 7))
                End If
            Next i
            j = j + 1
            Target.Value = s & Format(CStr(j), "0000000")
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

When a few H & C's are entered:

Book1
	B
2	C0010080
3	H0001775
4	C0010081
5	C0010082
6	C0010083
7	C0010084
8	C0010085
9	C0010086
10	C0010087
11	H0001776
12	H0001777
13	H0001778
14	H0001779
15
16
17
18
Sheet1

Book1
	B
2	C0010080
3	H0001775
4	C0010081
5	C0010082
6	C0010083
7	C0010084
8	C0010085
9	C0010086
10	C0010087
11	H0001776
12	H0001777
13	H0001778
14	H0001779
15	C0010088
16	H0001780
17	C0010089
18	C0010090
19
Sheet1

 

[arjan kooger]

Both of you thank you very much for the examples!!

This was exactly what i was looking for, it was my first time to ask on a forum and did not expect such a quick reply and solution, thanks again.

For this project i go for the VBA solution, but also @awoohaw Thanks for your formula, i save it for future use since in this sheet column D (Cold and Hot) already contain a formula.


@kevin9999 This works exactly as i wanted, thank you very much. i just was not clear which column was involved (C), so i chanced it in column in 3.


1 More question: my sheet contained already a Code for auto capitalise letter in column AC, but if i intergrade part of that code in your code, excel will crash, probably because it is both worksheet change.

I don't know if it can be intergraded in your code, but if not, no problem, since we change those letter only once a day at shift change.


Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Not Intersect(Target, Range("AC:AC")) Is Nothing Then

Target.Value = UCase(Application.Substitute(Target.Value, " ", ""))

End If

Application.EnableEvents = True

End Sub

Thanks again both of you!

​

 

[kevin9999]

Glad we were able to help & welcome to the Forum
What you're asking for shouldn't be a problem, try the following code & see how you go:
EDITED

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        If Target.Column = 3 And (UCase(Target) = "H" Or UCase(Target) = "C") Then
            On Error GoTo Escape
            Application.EnableEvents = False
            Dim s As String, i As Long, j As Long, a
            s = UCase(Target)
            a = Range("C2", Target.Offset(-1))
            For i = LBound(a, 1) To UBound(a, 1)
                If UCase(Left(a(i, 1), 1)) = s Then
                    If CInt(Right(a(i, 1), 7)) > j Then j = CInt(Right(a(i, 1), 7))
                End If
            Next i
            j = j + 1
            Target.Value = s & Format(CStr(j), "0000000")
        End If
        If Target.Column = 29 Then
            Target.Value = UCase(Application.Substitute(Target.Value, " ", ""))
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[awoohaw]

you're welcome. Great job @kevin9999!!!

 

[arjan kooger]

Glad we were able to help & welcome to the Forum
What you're asking for shouldn't be a problem, try the following code & see how you go:
EDITED

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        If Target.Column = 3 And (UCase(Target) = "H" Or UCase(Target) = "C") Then
            On Error GoTo Escape
            Application.EnableEvents = False
            Dim s As String, i As Long, j As Long, a
            s = UCase(Target)
            a = Range("C2", Target.Offset(-1))
            For i = LBound(a, 1) To UBound(a, 1)
                If UCase(Left(a(i, 1), 1)) = s Then
                    If CInt(Right(a(i, 1), 7)) > j Then j = CInt(Right(a(i, 1), 7))
                End If
            Next i
            j = j + 1
            Target.Value = s & Format(CStr(j), "0000000")
        End If
        If Target.Column = 29 Then
            Target.Value = UCase(Application.Substitute(Target.Value, " ", ""))
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

Hello Kevin9999,

Thanks for your help, i did try it but i got the same result as when i added part of the uppercase code before, it does put uppercase 1 time in the cell when i press enter, but then i got a debug/end messagebox and cannot select any, and a few seconds later Excel crashes and shutdown.

I will try it when i'm at home on my own PC, since i use corporate PC now, maybe they don't like to much tinkering, use of marco's is limited.

 

[kevin9999]

It worked for me on a sample file I created - are you able to share your actual file via Google Drive, Dropbox or similar file sharing platform so we can get to the bottom of the problem?

 

[arjan kooger]

It worked for me on a sample file I created - are you able to share your actual file via Google Drive, Dropbox or similar file sharing platform so we can get to the bottom of the problem?

I have to find out a file share service, its been a long time since i used it. i prepared a example copy of the file, but since the company restrict use of macro ( as user you have to request activation of macros for your account), i have some other little programs who do not run nicely or let Excel crash, although other Excel files with a lot of macros run fine. what i see now that it seems to enter a loop of some sort (mouse pointer is flickering) and then the debug message box pops up and excel start to shutdown.