Automatisch oplopende serienummer geven

Status
Niet open voor verdere reacties.
I

Igin19

Gebruiker
Lid geworden
13 jan 2021
Berichten
16
Hoi allemaal,

Mijn collega heeft in het verleden een database opgemaakt met onderstaande vba code.
De bedoeling is dat in kolom C wordt gezocht naar het hoogste serienummer (SKXXX), nadien wordt in de eerste vrije cel in kolom C het serienummer + 1 gezet.
M.a.w. zonder te sorteren krijgt de gebruiker het eerste 'vrije' serienummer te zien wanneer hij drukt op een 'knop'.

Code: 
Sub ToevoegenSK()

  ar = Cells(1).CurrentRegion.Columns(3)
  For j = 3 To UBound(ar)
    If LCase(Left(ar(j, 1), 2)) = "sk" Then t = IIf(Mid(ar(j, 1), 3) > t, Mid(ar(j, 1), 3), t)
  Next j
  Application.Goto Cells(Rows.Count, 3).End(xlUp).Offset(1, 0), True
  ActiveCell.Value = "SK" & Format(t + 1, "000")

  Application.Goto Reference:=Worksheets("DATABASE").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0), Scroll:=True

End Sub

Omwille van praktische redenen, moet de vorm van de serienummer gewijzigd worden naar 'HSKXXX' ipv 'SKXXX'.
Ik dacht de code aan te passen (zie rood), maar dit werkt enkel voor HSK001, niet meer voor HSK002 enz.
Excel geeft aan dat de fout zit in : ActiveCell.Value = "HSK & Format(t + 1, "000")

Code: 
Sub ToevoegenSK()

  ar = Cells(1).CurrentRegion.Columns(3)
  For j = 3 To UBound(ar)
    If LCase(Left(ar(j, 1), [COLOR="#FF0000"]3[/COLOR])) = "[COLOR="#FF0000"]hsk[/COLOR]" Then t = IIf(Mid(ar(j, 1), 3) > t, Mid(ar(j, 1), 3), t)
  Next j
  Application.Goto Cells(Rows.Count, 3).End(xlUp).Offset(1, 0), True
  ActiveCell.Value = "[COLOR="#FF0000"]HSK[/COLOR]" & Format(t + 1, "000")

  Application.Goto Reference:=Worksheets("DATABASE").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0), Scroll:=True

End Sub

Kan iemand me helpen dat de code wel werkt?
Alvast veel dank...
 
En wat is de foutmelding zelf?
 
Dag Edmoor,

Fout 13 tijdens uitvoering
Typen komen niet met elkaar overeen

grtjes
 
Plaats dan een voorbeeld documentje.
 
Maar er dit van:
Code: 
Sub ToevoegenHSK()
  ar = Cells(1).CurrentRegion.Columns(3)
  For j = 3 To UBound(ar)
    If LCase(Left(ar(j, 1), 3)) = "hsk" Then t = IIf(Mid(ar(j, 1), [COLOR="#FF0000"]4[/COLOR]) > t, Mid(ar(j, 1), [COLOR="#FF0000"]4[/COLOR]), t)
  Next j
  Application.Goto Cells(Rows.Count, 3).End(xlUp).Offset(1, 0), True
  ActiveCell.Value = "HSK" & Format(t + 1, "000")

  Application.Goto Reference:=Worksheets("DATABASE").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0), Scroll:=True
End Sub
 
Graag gedaan en welkom bij Helpmij :)
 
Code: 
Sub M_snb()
  Application.Goto Blad2.Cells(Rows.Count, 3).End(xlUp).Offset(1), True
  ActiveCell = "HSK" & Format([max(if(C3:C999="",0,--mid(C3:C999,4,3)))] + 1, "000")
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan