Option ExplicitSub LoopIt() Dim i As Integer For i = 1 To 16 Call NumberGenerator Next i End SubSub NumberGenerator() Dim ev() As Variant 'even digits Dim od() As Variant 'odd digits Dim lo() As Variant 'low digits Dim hi() As Variant 'high digits Dim OUT() As Variant 'output list Dim FMT() As Variant 'format list Dim strFMT As String 'text handle for format list Dim x As Integer, y As Integer 'input "dimensions" Dim i As Integer, j As Integer, k As Integer 'counters for each output digit Dim z As Long, n As Long, c As Long 'counter for which output we are on (z, n) = row, c = col Dim xMap As New Collection 'semi-auto mapping of digits to array location 'Populate the input arrays ev() = Array(0, 2, 4, 6, 8) od() = Array(1, 3, 5, 7, 9) lo() = Array(0, 1, 2, 3, 4) hi() = Array(5, 6, 7, 8, 9) 'Populate the "dimensions" n = 1 'start output array counter at 1 for human readability x = 3 'how many digits we output y = 4 'how many digit arrays we input z = y ^ x 'number of final combinations 'Redim the output arrays with the dimensions ReDim OUT(1 To z, 1 To x) '("row", "col") ReDim FMT(1 To z, 1 To x) '("row", "col") 'Create the mapping from variables to digit location With xMap .Add 1, "i" .Add 2, "j" .Add 3, "k" End With For i = 1 To y For j = 1 To y For k = 1 To y Select Case i Case 1: FMT(n, xMap("i")) = "e": OUT(n, xMap("i")) = ev(RndInt(LBound(ev), UBound(ev))) Case 2: FMT(n, xMap("i")) = "o": OUT(n, xMap("i")) = od(RndInt(LBound(od), UBound(od))) Case 3: FMT(n, xMap("i")) = "l": OUT(n, xMap("i")) = lo(RndInt(LBound(lo), UBound(lo))) Case 4: FMT(n, xMap("i")) = "h": OUT(n, xMap("i")) = hi(RndInt(LBound(hi), UBound(hi))) End Select Select Case j Case 1: FMT(n, xMap("j")) = "e": OUT(n, xMap("j")) = ev(RndInt(LBound(ev), UBound(ev))) Case 2: FMT(n, xMap("j")) = "o": OUT(n, xMap("j")) = od(RndInt(LBound(od), UBound(od))) Case 3: FMT(n, xMap("j")) = "l": OUT(n, xMap("j")) = lo(RndInt(LBound(lo), UBound(lo))) Case 4: FMT(n, xMap("j")) = "h": OUT(n, xMap("j")) = hi(RndInt(LBound(hi), UBound(hi))) End Select Select Case k Case 1: FMT(n, xMap("k")) = "e": OUT(n, xMap("k")) = ev(RndInt(LBound(ev), UBound(ev))) Case 2: FMT(n, xMap("k")) = "o": OUT(n, xMap("k")) = od(RndInt(LBound(od), UBound(od))) Case 3: FMT(n, xMap("k")) = "l": OUT(n, xMap("k")) = lo(RndInt(LBound(lo), UBound(lo))) Case 4: FMT(n, xMap("k")) = "h": OUT(n, xMap("k")) = hi(RndInt(LBound(hi), UBound(hi))) End Select n = n + 1 Next k Next j Next i 'Combine each array "row" and output to the worksheet With ActiveSheet 'Grab the column we will use using row 1 c = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 'Fix for empty worksheet If c = 2 And Not WorksheetFunction.CountA(.Columns(1)) Then c = 1 '[optional, comment block out if not needed] 'Output format to first column if not found strFMT = "FMT: " If .UsedRange.Find(strFMT) Is Nothing Then For n = 1 To z With .Cells(n, c) .NumberFormat = "@" .Value = _ strFMT & _ FMT(n, xMap("i")) & _ FMT(n, xMap("j")) & _ FMT(n, xMap("k")) End With Next n c = c + 1 'move to next column End If 'Output values to chosen column For n = 1 To z With .Cells(n, c) .NumberFormat = CStr(Application.WorksheetFunction.Rept("0", x)) .Value = _ Val( _ OUT(n, xMap("i")) & _ OUT(n, xMap("j")) & _ OUT(n, xMap("k")) _ ) End With Next n End With End SubPublic Function RndInt(Num1 As Integer, Num2 As Integer) As Integer ' Author : Stormin' Date Created : July 2017' Purpose : Generates a random integer between two integer bounds (inclusive)' Notes : Min and Max functions are Excel-specific Dim UP As Integer Dim lo As Integer With Application.WorksheetFunction UP = .Max(Num1, Num2) lo = .Min(Num1, Num2) End With Randomize 'Randomises the seed for Rnd function RndInt = Int((UP - lo + 1) * Rnd + lo) End Function