Random Place Name Generator

Option Explicit
Sub RandomlyOrderedCategoryCombinations()

    Dim r As Range
    Dim cl As Long, rw As Long
    Dim arr As Variant, cumCombinations As Variant, cntCategory As Variant
    
    
    Set r = Selection
    cl = r.Columns.Count
    ReDim cumCombinations(1 To cl)
    ReDim cntCategory(1 To cl)
    
    Do While cl >= 1
        cntCategory(cl) = Application.WorksheetFunction.CountA(r.Columns(cl))
        
        If cl <> r.Columns.Count Then
            cumCombinations(cl) = cumCombinations(cl + 1) * cntCategory(cl)
        Else
            cumCombinations(cl) = cntCategory(cl)
        End If
        
        cl = cl - 1
    Loop
    
    Dim i As Long, j As Long
    ReDim arr(1 To cumCombinations(1), 1 To 2)
    
    For i = 1 To cumCombinations(1)
        For j = 1 To r.Columns.Count
            arr(i, 1) = arr(i, 1) & r.Cells(Int((i - 1) * cntCategory(j) / cumCombinations(j)) Mod cntCategory(j) + 1, j) & " "
        Next j
        
        arr(i, 1) = Trim(arr(i, 1))
        arr(i, 2) = Rnd
    Next i

    Set r = r.Offset(, r.Columns.Count).Resize(UBound(arr, 1), 2)
    r.Value = arr
    r.Sort Key1:=r.Offset(, 1).Resize(1, 1)
    r.Columns(2).Clear

End Sub