VBA beadando 2 - Milton

modile2.vba

Sub CalculateSerialNumbers()
    'Define ranges for loops
    Dim productCell As Range
    Dim SerialCell As Range
    
    'Loop through products (main loop)
    Set currentCell = Range("B5")
    Set productCell = Range("G5")
    Dim qty As Integer
    
    Do While Not IsEmpty(currentCell.Value)
        'Generate each serial number row for product
        qty = currentCell.Offset(0, 2).Value
        For i = 1 To qty
            productCell.Value = currentCell.Value
            productCell.Offset(0, 1).Value = i
            productCell.Offset(0, 2).Value = currentCell.Offset(0, 1).Value
            productCell.Offset(0, 3).Value = generateSerial(8)
            Set productCell = productCell.Offset(1, 0)
        Next i
        Set currentCell = currentCell.Offset(1, 0)
    Loop
    
End Sub

'Function, to generate SerialNumber
Function generateSerial(n As Long) As String
    Dim i As Long, j As Long, m As Long, s As String, pool As String
    pool = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    m = Len(pool)
    For i = 1 To n
        j = 1 + Int(m * Rnd())
        s = s & Mid(pool, j, 1)
    Next i
    generateSerial = s
End Function