Random Data Generator using List of Items in Columns

I need to take a series of populated columns and generate many rows of combinations with random values.

I've managed to write some VBA that is neither efficient nor stylish - however, on the whole, it works.

All except for one issue, which I'll come on to in a minute.

The code reads down each of the 10 columns outputting to a code combination, adding a random value in the 11th column. The following image shows the example of the input source of 10 lists of items:

Input sheet

The current Output shows the merger of the lists, with a random value: Output sheet

The issue that I have is, if just one of the input columns has just 1 item, UBound() fails with a type mismatch. This will fail: Remove FY25

Please use the code below to run and test after setting up the following fields in a tab called ListDims.

I'm sure that the whole code can be simplified by using arrays, so feel free to offer a simpler, quicker solution.

Sub RandomCombo()
    Dim wsOutSheet As Worksheet
       
    'Change this to point to the start column of the first dimension output
    lnStartcol = 13
    lnNoOfDims = 10
    
    ListA = Application.WorksheetFunction.Transpose(Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value) 'data starts in 2nd row
    ListB = Application.WorksheetFunction.Transpose(Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value) 'data starts in 2nd row
    ListC = Application.WorksheetFunction.Transpose(Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value) 'data starts in 2nd row
    ListD = Application.WorksheetFunction.Transpose(Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value) 'data starts in 2nd row
    ListE = Application.WorksheetFunction.Transpose(Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row).Value) 'data starts in 2nd row
    ListF = Application.WorksheetFunction.Transpose(Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row).Value) 'data starts in 2nd row
    ListG = Application.WorksheetFunction.Transpose(Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row).Value) 'data starts in 2nd row
    ListH = Application.WorksheetFunction.Transpose(Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row).Value) 'data starts in 2nd row
    ListI = Application.WorksheetFunction.Transpose(Range("I2:I" & Cells(Rows.Count, "I").End(xlUp).Row).Value) 'data starts in 2nd row
    ListJ = Application.WorksheetFunction.Transpose(Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row).Value) 'data starts in 2nd row

    Application.DisplayAlerts = False
    lnCounter = 2
    If (Sheet_Exists("Data") = True) Then
        Sheets("Data").Delete
    End If
    If (Sheet_Exists("Data") = False) Then
        Sheets.Add(After:=Sheets("ListDims")).Name = "Data"

    End If
    
    Set wsOutSheet = ThisWorkbook.Worksheets("Data")
    
    Sheets("ListDims").Select

   
    Range(Cells(1, lnStartcol), Cells(100000, lnStartcol + 10)).Select
    Range(Cells(1, lnStartcol), Cells(100000, lnStartcol + 10)).Clear
    
    Cells(1, lnStartcol) = Cells(1, 1)
    For i = 1 To lnNoOfDims
        Cells(1, lnStartcol + i) = Cells(1, 1 + i)
    Next i
    
    
    For a = 1 To UBound(ListA)
        For b = 1 To UBound(ListB)
            For c = 1 To UBound(ListC)
                For d = 1 To UBound(ListD)
                    For e = 1 To UBound(ListE)
                        For f = 1 To UBound(ListF)
                             For g = 1 To UBound(ListG)
                                For h = 1 To UBound(ListH)
                                    For i = 1 To UBound(ListI)
                                        For j = 1 To UBound(ListJ)
                                            Cells(lnCounter, lnStartcol) = ListA(a)
                                            Cells(lnCounter, lnStartcol + 1) = ListB(b)
                                            Cells(lnCounter, lnStartcol + 2) = ListC(c)
                                            Cells(lnCounter, lnStartcol + 3) = ListD(d)
                                            Cells(lnCounter, lnStartcol + 4) = ListE(e)
                                            Cells(lnCounter, lnStartcol + 5) = ListF(f)
                                            Cells(lnCounter, lnStartcol + 6) = ListG(g)
                                            Cells(lnCounter, lnStartcol + 7) = ListH(h)
                                            Cells(lnCounter, lnStartcol + 8) = ListI(i)
                                            Cells(lnCounter, lnStartcol + 9) = ListJ(j)
                                            
                                            'Generate a random value
                                            Cells(lnCounter, lnStartcol + 10) = WorksheetFunction.RandBetween(100, 9999)
                                            lnCounter = lnCounter + 1
                                        Next j
                                    Next i
                                Next h
                            Next g
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    
    Application.CutCopyMode = False
    Selection.Copy
    
    Sheets("Data").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("ListDims").Select
    Selection.Clear
    Range("A1").Select
    Sheets("Data").Select
    Range("A1").Select
    Application.DisplayAlerts = True
    
End Sub
Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet

Sheet_Exists = False

For Each Work_sheet In ThisWorkbook.Worksheets

    If Work_sheet.Name = WorkSheet_Name Then
        Sheet_Exists = True
    End If

Next

End Function