Randomized Map

[Andresleo47]

Hi, I'm working on a project where I have 2 sets of tiles, Upper Leve and Lower Level. 2-4 tiles will be randomly generated on each level, and several routes will be connected between two adjacent levels.

There are some restrictions:

There will be no lines connecting tiles on the same level the lines are straight and cannot cross and Every tile must have at least 1 line.

I am working this out with Random Numbers, suing the below modules:

Sub GeneratingARandomNumber()

Dim M As Integer
For M = 7 To 10
    ActiveSheet.Cells(6, M) = "=INDEX(UNIQUE(RANDARRAY(1,4,0,4,TRUE)),SEQUENCE(10))"
Next M



End Sub

Sub GeneratingARandomNumber2()


Dim N As Integer
For N = 7 To 10
    ActiveSheet.Cells(12, N) = "=INDEX(UNIQUE(RANDARRAY(1,4,0,4,TRUE)),SEQUENCE(10))"
Next N



End Sub

However, I'm not finding a way to avoid repetitions and to make the code flow with the restrictions of the exercise. Can you give me a quick hand?

Thanks!!

 

[Andresleo47]

**UPDATE**

Hi guys, I found another way to do it using letters (Attached). Here's the code:

Sub Test()
Dim arr, vec() As String, dmy As String
Dim r1 As Integer, r2 As Integer, r3 As Integer, counter As Integer
Dim myDataRng As Range
Dim cell2 As Range


Dim RandomRange As Range, cell As Range
 Range("G1:G100").Clear
Set RandomRange = Range("A1:D2")
For Each cell In RandomRange
cell.Formula = "=CHAR(RANDBETWEEN(65,90))"

Next
RandomRange.Value = RandomRange.Value

    ' SET THE RANGE (SECOND COLUMN).
    Set myDataRng = Range("A1:D2")

    For Each cell2 In myDataRng
        If InStr(1, cell2.Value, "N") > 0 Then
            cell2.Value = Replace(cell2.Value, "N", "0")
    
        End If
    Next cell2

arr = Range("A1:D2").Value
    For r1 = 1 To 4
      For r2 = 1 To 4
            dmy = Join(Array(arr(1, r1), arr(2, r2), " "))
            If InStr(dmy, "0") = 0 Then
                counter = counter + 1
                ReDim Preserve vec(counter)
                vec(counter) = dmy
            End If
        Next
      Next
    




Range("G1").Resize(counter + 1, 1).Value = Application.WorksheetFunction.Transpose(vec)
End Sub

However, what this code is missing is the "Not crossing" part. For example in the attachment, QF shouldn't be a connection because it crosses over OM.

Other than that, I think I'm in the right direction.

Any input is appreciated! Thanks,

 

[Sulprobil]

Hello,
For the crossings you will require a histogram distribution, I think. Google for sbRandHistoGrm, for example.
It will then be easy to set the weight for unwanted areas/values to zero.
Regards,
Bernd

 

[Andresleo47]

Hi, thanks for your answer. I have Goggled, but it seems to be a function, right? How can I add it to the code?

Thanks,

Andres

 

[Sulprobil]

Hello,
For an example please search here (or again, google) for sbExactRandHistoGrm.
You can use either function, I believe.
Regards,
Bernd