I need help in writing a code in Excel to run a macro that will
generate sequential numbers. The sequential numbers will start based on
a predefined list of already used numbers that cannot be used again (as
shown below ). The sequential number string will be determined by the
classification of the new data. As shown below if new data is BLDG, a
sequential number starting with BLDG05 will be assigned since BLDG04
was th last assigned sequential number.

Predefined list (Already Used #s)
BLDG01 HSKG01
BLDG02 HSKG02
BLDG03
BLDG04

For example,
Classification Sequential #
enter new data BLDG BLDG05
enter new data BLDG BLDG06
enter new data HSKG HSKG03
enter new data BLDG BLDG07

Anyone has any ideas or codes that can work? I'll surely appreciate it.

Assume last code for each class is on a
worksheet, e.g. cells A1 and B1 on Sheet1
for the following.

Sub NewCode()
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
str1 = Sheets("Sheet1").Range("A1")
iCol = 1
Else 'iCls=2
str1 = Sheets("Sheet1").Range("B1")
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(1, iCol) = str1
Loop
error_trap:
End Sub

Hth,
Merjet

Thanks so much Merjet for the code. It's working up to a point. My
problem is: the last code for each class is being replaced by the new
number in cell A1. Assuming that the codes are arranged in the order as
shown below:

BLDG01 (Cell A1) HSKG01 (Cell B1)
BLDG02 (Cell A2) HSKG02 (Cell B2)
BLDG03 (Cell A3) Last blank cell (Cell B3)
BLDG04 (Cell A4)
Last blank cell(Cell A5)

The next sequential number if 1--BLDG would be BLDG05 and should be put
in the last blank cell in either column A or B. Please note the last
blank cell will always change as a new sequential number is generated.
So if the next sequential number is a 1 BLDG06 will be put in cell A6
and the same will also apply to column B.

Thanks for your help!



On Jan 23, 7:35 pm, "merjet" wrote:
Assume last code for each class is on a
worksheet, e.g. cells A1 and B1 on Sheet1
for the following.

Sub NewCode()
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
str1 = Sheets("Sheet1").Range("A1")
iCol = 1
Else 'iCls=2
str1 = Sheets("Sheet1").Range("B1")
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(1, iCol) = str1
Loop
error_trap:
End Sub

Hth,
Merjet

I made some clarifications to my earlier response so that it's clear
what I'm explaining.

Thanks so much Merjet for the code. It's working up to a point. My
problem is: the last code for each class is being replaced by the new
number in cell A1. Assuming that the codes are arranged in the order as
shown below:

BLDG01 (Cell A1) HSKG01 (Cell B1)
BLDG02 (Cell A2) HSKG02 (Cell B2)
BLDG03 (Cell A3) Last blank cell (Cell B3)
BLDG04 (Cell A4)
Last blank cell(Cell A5)

The next sequential number if 1--BLDG would be BLDG05 and should be put
in the last blank cell in column A.
Please note the last blank cell will always change as a new sequential
number is generated.
So if the next sequential number is a 1, it'll be BLDG06 and this will
be put in cell A6
The same concept will also apply to column B.

Thanks for your help!

On Jan 23, 7:35 pm, "merjet" wrote:



Assume last code for each class is on a
worksheet, e.g. cells A1 and B1 on Sheet1
for the following.

Sub NewCode()
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
str1 = Sheets("Sheet1").Range("A1")
iCol = 1
Else 'iCls=2
str1 = Sheets("Sheet1").Range("B1")
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(1, iCol) = str1
Loop
error_trap:
End Sub

Hth,
Merjet- Hide quoted text -- Show quoted text -

I didn't know what you wanted to do with the new codes.
If you want to collect them in columns, then do the
following replacements:

Replace: str1 = Sheets("Sheet1").Range("A1")
with: iRow = Sheets("Sheet1").Range("A1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("A" & iRow)

Replace: str1 = Sheets("Sheet1").Range("B1")
with: iRow = Sheets("Sheet1").Range("B1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("B" & iRow)


Replace: Sheets("Sheet1").Cells(1, iCol) = str1
With: Sheets("Sheet1").Cells(iRow + 1, iCol) = str1

Hth,
Merjet

Thanks Merjet. How do I modify the code to include more than 2 columns.
My number of columns will keep growing...might eventually be about 20
columns.
I attempted to modify the code but I'm getting an error with the loop
statement:

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 2 for HSKG 3 for
MAIN 4 for LCWO")
If iCls = 1 Then
iRow = Sheets("Sheet1").Range("A1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("A" & iRow)
iCol = 1
Else
If iCls = 2 Then
iRow = Sheets("Sheet1").Range("B1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("B" & iRow)
iCol = 2
Else
If iCls = 3 Then
iRow = Sheets("Sheet1").Range("c1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("c" & iRow)
iCol = 3
Else
iCls = 4
iRow = Sheets("Sheet1").Range("d1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("d" & iRow)
iCol = 4
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







On Jan 23, 9:14 pm, "merjet" wrote:
I didn't know what you wanted to do with the new codes.
If you want to collect them in columns, then do the
following replacements:

Replace: str1 = Sheets("Sheet1").Range("A1")
with: iRow = Sheets("Sheet1").Range("A1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("A" & iRow)

Replace: str1 = Sheets("Sheet1").Range("B1")
with: iRow = Sheets("Sheet1").Range("B1").End(xlDown).Row
str1 = Sheets("Sheet1").Range("B" & iRow)

Replace: Sheets("Sheet1").Cells(1, iCol) = str1
With: Sheets("Sheet1").Cells(iRow + 1, iCol) = str1

Hth,
Merjet