Solved: auto number

[ajm]

hi folks, am trying to get a number generator to work for my project register but am having trouble thinking it through from a vba perspective.

I am setting up a Project Register which will record my team's activity this year. Once they have filled in certain fields in a row, I want to generate a project reference number for them. At the moment, I am just trying to get it to work from a Button but will eventually set it to run from a sheet change event which checks to see that certain fields are filled in before generating the number.

The number itself is a combination of text and numerics - "GP10-001" (next will be GP10-002, etc).

I have this so far with only the number component done:

Sub ProjNbr()
Dim r As Integer
Dim rng As Range
Set rng = Range("RefNbrRg") '''this is column I which holds Ref Nbrs
If Worksheets("Project Register").Range("i4") = "" Then '''first proj to be 001
c = Worksheets("Project Register").Range("i4")
r = 1
For Each c In Selection
c.Value = r
r = r + 1
ActiveCell.NumberFormat = "000"
Next c

End If

End Sub

I simply want a sequential number created to the last entry and that new number put in the active row (intersecting with Col I eg I3). I am making a mess of it and would appreciate any suggestions.

[geekgirlau]

This is one idea.

My assumption is that you don't want to reassign existing numbers - you want to add new numbers as required.

First, the range "RefNbrRg" has the number format "GP10-"000. This means that you type only the number (eg 10) and it will display as "GP10-010".

There is a worksheet change event that is checking every time you make a change in the range "DataEntry" (I've highlighted an area on the sample sheet). If a value is typed in the first 3 columns in this area (and provided a number has not already been assigned) it then assigns the next number.


Private Sub Worksheet_Change(ByVal Target As Range)
' change made in specific area of the sheet
If Not Intersect(Range("DataEntry"), Target) Is Nothing Then
Application.EnableEvents = False

' number has not already been assigned
If Cells(Target.Row, 9).Value = 0 Then
' check that all required values have been entered
If Cells(Target.Row, 1) <> "" And _
Cells(Target.Row, 2) <> "" And _
Cells(Target.Row, 3) <> "" Then

' get the nextnumber
Cells(Target.Row, 9) = WorksheetFunction.Max(Range("RefNbrRg")) + 1
Cells(Target.Row, 9).NumberFormat = """GP10-""000"
End If
End If

Application.EnableEvents = True
End If
End Sub

[ajm]

thanks geekgirlau. very nice.

[geekgirlau]

My pleasure - don't forget to mark the thread as "Solved" using the Thread Tools at the top of the page.

[ajm]

before i do that, can i add a little twist? i have chnaged it to run off a beforedoubleclick event and need some help tidying it up. should i start a new thread or continue here?

[mdmackillop]

Please continue here.

[ajm]

i am trying to change the event to a before double click and am having trouble. here is what i have attempted:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'///add a tick when cell within range(s) is doubleclicked

If Intersect(Target, Range("RefNbrRg")) <> "" Then Exit Sub
Cancel = True 'Prevent going into Edit Mode

' number has not already been assigned
If Cells(Target.Row, 9).Value = 0 Then
' check that all required values have been entered
If Cells(Target.Row, 1) <> "" And _
Cells(Target.Row, 2) <> "" And _
Cells(Target.Row, 3) <> "" Then

' get the nextnumber
Cells(Target.Row, 9) = WorksheetFunction.Max(Range("RefNbrRg")) + 1
Cells(Target.Row, 9).NumberFormat = """GP10-""000"
End If
End If

Application.EnableEvents = True

On Error GoTo 0

End Sub

if you doubleclick in Column I, this provides a new number in that column so long as there is something entered into columns A, B, C on that row. If i double click elsewhere on the sheet, I get a "object variable or with block variable not set" error on the If Interesect line. how do i handle this error to not happen.

[mdmackillop]

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'///add a tick when cell within range(s) is doubleclicked
Dim c As Range

Set c = Intersect(Target, Range("RefNbrRg"))
If c Is Nothing Then Exit Sub
If c <> "" Then Exit Sub

Cancel = True 'Prevent going into Edit Mode

' number has not already been assigned
If Cells(c.Row, 9).Value = 0 Then
' check that all required values have been entered
If Application.CountA(Cells(c.Row, 1).Resize(, 3)) = 3 Then
' get the nextnumber
Cells(c.Row, 9) = WorksheetFunction.Max(Range("RefNbrRg")) + 1
Cells(c.Row, 9).NumberFormat = """GP10-""000"
Else
MsgBox "Missing data"
End If
End If
End Sub

[ajm]

cheers mate. works well