Adding batches of serial numbers

Hi,

I have to keep track of the location of batches of certificates. To do this I want a spreadsheet which will show the 3 letter prefix in column A, and the first certificate number of each pack within the batch in column B.
Cell H1 contains the number of certificates in each pack
So far I have:

Code:

---

Sub AddNewPacks()

Dim Amount As String, Prefix As String, Firstno As String, Counter As Integer, Thisgo As Integer
Prefix = InputBox("Please enter the Prefix of the certificates being added")
Amount = InputBox("Please enter the number of packs to be added")
If Amount = "" Then Exit Sub
If Amount > 1000 Then
MsgBox "Invalid Amount. Number of packs cannot be more than 1000"
Exit Sub
End If
For Thisgo = 1 To Amount
Range("A1").End(xlDown).Offset(1, 0).Value = Prefix
Next Thisgo

Firstno = InputBox("Please enter the low st serial number")
If Firstno > 999999 Then
MsgBox "Invalid Serial Number."
Exit Sub
End If
Range("B1").End(xlDown).Offset(1, 0).Value = Firstno
For Counter = 1 To Amount
ActiveCell.Offset(1, 0).Value = ActiveCell + H1
Next Counter
End Sub

---

This puts the prefix in A the correct number of times, but I can't get the serial number part to work.
Any help would be appreciated

1. I added CODE tags around your macro to set it off and do a little formatting -- you can use the[#] icon to insert beginning and ending CODE tags to paste the macro between

2. "Can't get it to work" is a little (OK, a lot) ambiguous. An error message or wrong result usually helps

3. Guessing just by looking at the code, you probably wanted this

Code:

---

        ActiveCell.Offset(1, 0).Value = ActiveCell + Range("H1")

---

Test:

Code:

---

Sub AddNewPacks2()
Dim Amount As String, Prefix As String, Firstno As String
Prefix = InputBox("Please enter the Prefix of the certificates being added")
Amount = InputBox("Please enter the number of packs to be added")
If Amount = "" Then Exit Sub
If Amount > 1000 Then
  MsgBox "Invalid Amount. Number of packs cannot be more than 1000"
  Exit Sub
End If
Firstno = InputBox("Please enter the low st serial number")
If Firstno > 999999 Then
  MsgBox "Invalid Serial Number."
  Exit Sub
End If
With Range("A1").End(xlDown).Offset(1).Resize(Amount)
  .Value = Prefix
  .Offset(, 1).FormulaR1C1 = "=R[-1]C+1"
  .Offset(, 1).Cells(1).Value = Firstno
  .Offset(, 1).Value = .Offset(, 1).Value
End With
End Sub

---

Paul - Thanks for setting me straight

P45cal - Thank you, that works exactly as I hoped except I need the values in column B to increase by the value in H1

change:
.Offset(, 1).FormulaR1C1 = "=R[-1]C+1"
to:
.Offset(, 1).FormulaR1C1 = "=R[-1]C+R1C8"

Amazing

Thank you