Sequential Number Generator Macro

[theCityLight]

I'm not a programmer and I need help in completing a sequential number
generator code that I need for work. It has already been started with
some help that I've gotten from this group. I'm revamping my needs and
here's what I'd like to do. I have 21 identifiers (all 4 characters)e.g

BLDG HSKG LCWM MAIN UTIL LCWO ENRG AMGT ITEA I&CS METR EHSS EHSG ITEH EHSR ITFP PLNG ACTG ADMN SECT ITTC

Also I have some numbers that can no longer be used e.g,
BLDG01 HSKG01 LCWM01 MAIN01 UTIL01 LCWO01 ENRG02
BLDG02 UTIL02 ENRG03

Can someone help write a macro that will generate the next sequential
number for each identifier? The macro will genarte an input box which
will ask for the first 4 letter characters e.g HSKG, and then it will
generate the next sequential number and put it in the cell below e.g
for KSKG, it will generate HSKG02 and put it underneath HSKG01 and
highlight the cell (HSKG02)yellow and make the font red.

So the next sequential number will always be put underneath the last
populated cell in the related column and highlighted in yellow and red
font.

Can anyone help with this?

The code that I already have is pasted below but it needs to be
modified to incorporate my needs above. Also, It works only when there
is more than 1number in a column but it doesn't work when there is only
1 number in a column.

Sub Macro2()
Dim str1 As String
Dim iNum As Integer
Dim iCol As Integer
Dim iCls As Integer


On Error GoTo error_trap
Do
'error will occur if InputBox returns blank
iCls = InputBox("Enter class -- 1 for BLDG or 2 for HSKG.")
If iCls = 1 Then
iRow = Sheets("Sheet1").Range("A1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("A" & iRow)
iCol = 1
Else 'iCls=2
iRow = Sheets("Sheet1").Range("B1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("B" & iRow)
iCol = 2
End If
iNum = Right(str1, Len(str1) - 4)
If iNum < 10 Then
str1 = Left(str1, 4) & "0" & iNum + 1
Else
str1 = Left(str1, 4) & iNum + 1
End If
Sheets("Sheet1").Cells(iRow + 1, iCol) = str1
Loop
error_trap:
End Sub

 

[merjet]

See below. It assumes at least 1 entry in each of
21 columns; 1 column for each classification.

Hth,
Merjet

Sub NewCode()
Dim str1 As String
Dim str2 As String
Dim iNum As Integer
Dim iCol As Integer

On Error GoTo error_trap

str2 = "Enter class number -- 1-BLDG, 2-HSKG, 3-LCWM,"
str2 = str2 & " 4-MAIN, 5-UTIL , 6-LCWO, 7-ENRG, 8-AMGT,"
str2 = str2 & " 9-ITEA, 10-I&CS. 11-METR,12-EHSS, 13-EHSG,"
str2 = str2 & " 14-ITEH, 15-EHSR, 16-ITFP, 17-PLNG, 18-ACTG,"
str2 = str2 & " 19-ADMN, 20-SECT, 21-ITTC"
Do
'error will occur if InputBox returns blank
iCol = InputBox(str2)
iRow = Sheets("Sheet1").Cells(65536, iCol).End(xlUp).Row
str1 = Sheets("Sheet1").Cells(iRow, iCol)
iNum = Right(str1, Len(str1) - 4)
If iNum < 10 Then
str1 = Left(str1, 4) & "0" & iNum + 1
Else
str1 = Left(str1, 4) & iNum + 1
End If
Sheets("Sheet1").Cells(iRow + 1, iCol) = str1
Loop
error_trap:
End Sub
Sub

 

[merjet]

I forget the coloring.
Add these lines before "Loop":

Sheets("Sheet1").Cells(iRow, iCol).Interior.ColorIndex = xlNone
Sheets("Sheet1").Cells(iRow, iCol).Font.ColorIndex = 0
Sheets("Sheet1").Cells(iRow + 1, iCol).Interior.ColorIndex = 6
Sheets("Sheet1").Cells(iRow + 1, iCol).Interior.Pattern = xlSolid
Sheets("Sheet1").Cells(iRow + 1, iCol).Font.ColorIndex = 3

Hth,
Merjet

 

[theCityLight]

Merjet,
You are the BEST!!!. Thanks for your help and patience!...The code
absolutely worked!