rij invoegen en celwaarde +1

[matizje]

Hallo,

ik ben bezig om een offertenummer bestand aan te maken die automatisch d.m.v. een macro een rij invoegt en het vorige offertenummer met 1 ophoogt.
Het offertenummer moet er als volgt uit zien OF19001
Nu ik heb op dit forum onderstaande macro gevonden waarvoor dank. Deze macro heb ik iets aangepast zodat er al OF19 staat. Daarna genereert de macro 4 getallen i.p.v. 3 achter de OF19.
Als ik simpelweg in de macro van de "Format(NewNumber, "0000") het volgende maak "Format(NewNumber, "000"), dan wordt het nieuwe nummer OF199001.
Waar moet ik de macro aanpassen om de offertenummers OF19001 , OF19002, OF19003 te genereren.
Ik heb het bestand als bijlage toegevoegd

Alvast bedankt

macro:

Option Explicit

'Deze functie zoekt een nieuw ordernummer.
'Als er tussen het eerste en het laatste een vrij nummer is moeten we dat nemen.
'Het probleem is dat de kolom niet gesorteerd is.
'We zouden kunnen beginnen vanaf het eerste nummer en dat dat stapsgewijze verhogen
'en telkens de hele kolom aflopen. Dat gaat echter zeeeeeeeeer lang duren.
'We moeten op een gesorteerde lijst kunnen werken. Die kunnen we onderbrengen
'in een tijdelijke sheet.
'We gaan er van uit dat we in de Activesheet werken als we de macro aanroepen.
Sub GetNewSerialNumber()

Dim tempSheet As Worksheet
Dim mySheet As Worksheet
Dim myRange As Range
Dim oCells As Range
Dim r As Long
Dim myLastRow As Long
Dim NewNumber As Long

'De de actieve sheet bewaren we voor later gebruik, want als we een tijdelijke
'sheet bijvoegen wordt die de active sheet. Door het gebruik van twee sheetobjecten
'maakt het niet uit welke sheet de actieve is.
Set mySheet = ActiveSheet

'De tijdelijke sheet hoeven we niet in beeld te krijgen.
Application.ScreenUpdating = False

'Een tijdelijke sheet bijvoegen.
Set tempSheet = Worksheets.Add

'De laatste gegevensrij van de ordernummers opzoeken.
myLastRow = mySheet.Columns(1).Cells.Find(What:="*", SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

'De kolom met de ordernummers brengen we onder in een Range object.
Set myRange = mySheet.Range(mySheet.Cells(2, 1), mySheet.Cells(myLastRow, 1))

'En we kopieëren die Range naar de tijdelijke sheet.
myRange.Copy Destination:=tempSheet.Cells(1, 1)

'De ordernummers in de tijdelijke sheet sorteren.
'Dit is opgenomen code.
tempSheet.Columns(1).Sort Key1:=tempSheet.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'Vrij volgnummer zoeken.
Set oCells = tempSheet.Cells
r = 1
Do While oCells(r, 1).Value <> ""
If Val(Right(oCells(r + 1, 1).Value, 4)) = Val(Right(oCells(r, 1).Value, 4)) + 1 Then
r = r + 1
Else
NewNumber = Val(Right(oCells(r, 1).Value, 4)) + 1
Exit Do
End If
Loop

'De tijdelijke sheet hebben we niet meer nodig.
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True

'Vanaf hier willen we weer alles zien gebeuren.
Application.ScreenUpdating = True

'Het nieuwe ordernummer in de onderste cell van de kolom met de ordernummers schrijven.
mySheet.Cells(myLastRow + 1, 1).Value = "OF19" & Format(NewNumber, "0000")

End Sub

 

[VenA]

Dit lijkt mij wel voldoende

Sub VenA()
Dim ar
  With Cells(7, 1).CurrentRegion
    ar = .Value
    .Sort .Cells(1), , , , , , , 1
    Cells(Rows.Count, 1).End(xlUp).Offset(1) = "OF19" & Format(Val(Right(Cells(Rows.Count, 1).End(xlUp), 3)) + 1, "000")
    .Value = ar
  End With
End Sub

 

[matizje]

opgelost

dit is inderdaad voldoende, BEDANKT!!!!

 

[HSV]

Lijkt mij wel voldoende.

Sub hsv()
 Range("a8", Cells(Rows.Count, 1).End(xlUp).Offset(1)) = ["OF"&row(1:10000)+19000]
End Sub