Schulte table

[caccarazza]

Good morning,
I'm trying to do a schulte table 3x3 with random 5 alphanumeric.
Can you help me pls ? I need to see this table for just 1 second and then after 7 seconds another one with random positions, the numers are from 1 to 9 and the letters from A to Z.

 

[Aryatect]

Hi,

Below should work, sometimes it might give a duplicate value. For refreshing, you can press F9 key. If you need auto-refresh VBA code needs to be written for that as far as I know. You can refer to the below 2 links:

https://www.exceltip.com/tips/auto-refresh-excel-every-1-second-using-vba-in-excel.html

https://www.mrexcel.com/forum/excel-questions/362595-auto-refresh-every-3-minutes-using-macro.html

Sheet1​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<tbody>[TR]
[TH]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
[TR]
[TH]A1[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]B1[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]C1[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]A2[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]B2[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]C2[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]A3[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]B3[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
[TR]
[TH]C3[/TH]
[TD="align: left"]=VLOOKUP(RANDBETWEEN(1,35),$F$1:$G$35,2,FALSE)[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

	F	G
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
W
X
Y
Z

<tbody>
[TD="align: center"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]

[TD="align: center"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]

[TD="align: center"]6[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]

[TD="align: center"]7[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]

[TD="align: center"]8[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]

[TD="align: center"]9[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]9[/TD]

[TD="align: center"]10[/TD]
[TD="align: right"]10[/TD]

[TD="align: center"]11[/TD]
[TD="align: right"]11[/TD]

[TD="align: center"]12[/TD]
[TD="align: right"]12[/TD]

[TD="align: center"]13[/TD]
[TD="align: right"]13[/TD]

[TD="align: center"]14[/TD]
[TD="align: right"]14[/TD]

[TD="align: center"]15[/TD]
[TD="align: right"]15[/TD]

[TD="align: center"]16[/TD]
[TD="align: right"]16[/TD]

[TD="align: center"]17[/TD]
[TD="align: right"]17[/TD]

[TD="align: center"]18[/TD]
[TD="align: right"]18[/TD]

[TD="align: center"]19[/TD]
[TD="align: right"]19[/TD]

[TD="align: center"]20[/TD]
[TD="align: right"]20[/TD]

[TD="align: center"]21[/TD]
[TD="align: right"]21[/TD]

[TD="align: center"]22[/TD]
[TD="align: right"]22[/TD]

[TD="align: center"]23[/TD]
[TD="align: right"]23[/TD]

[TD="align: center"]24[/TD]
[TD="align: right"]24[/TD]

[TD="align: center"]25[/TD]
[TD="align: right"]25[/TD]

[TD="align: center"]26[/TD]
[TD="align: right"]26[/TD]

[TD="align: center"]27[/TD]
[TD="align: right"]27[/TD]

[TD="align: center"]28[/TD]
[TD="align: right"]28[/TD]

[TD="align: center"]29[/TD]
[TD="align: right"]29[/TD]

[TD="align: center"]30[/TD]
[TD="align: right"]30[/TD]

[TD="align: center"]31[/TD]
[TD="align: right"]31[/TD]

[TD="align: center"]32[/TD]
[TD="align: right"]32[/TD]

[TD="align: center"]33[/TD]
[TD="align: right"]33[/TD]

[TD="align: center"]34[/TD]
[TD="align: right"]34[/TD]

[TD="align: center"]35[/TD]
[TD="align: right"]35[/TD]

</tbody>

​

 

[lrobbo314]

Does this do what you are looking for?

Sub Shulte()
Dim AR(1 To 3, 1 To 3)
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim Board As Range
Dim r As Integer, Rounds As Integer

Set Board = Range("A1").Resize(UBound(AR), UBound(AR, 2))
For Rounds = 1 To 10
    For i = 65 To 90
        If i < 65 + (UBound(AR) * UBound(AR, 2)) Then AL.Add i - 64
        AL.Add Chr(i)
    Next i
    For j = 1 To UBound(AR)
        For k = 1 To UBound(AR, 2)
            r = Int((AL.Count - 1) * Rnd + 1)
            AR(j, k) = AL(r)
            AL.Removeat r
        Next k
    Next j
        
    Board.Font.ColorIndex = 0
    Board.Value = AR
    Application.Wait Now() + TimeValue("0:00:01")
    Board.Font.ColorIndex = 2
    Application.Wait Now() + TimeValue("0:00:07")
    AL.Clear
    DoEvents
Next Rounds
End Sub

 

[caccarazza]

Irobbo314 your vb is ok, but i just need 5 alphanumerical and not 9 as random....
for the orther one I'm trying but it's more complicate for me

 

[lrobbo314]

I don’t know what you mean. Can you post an example or explain in more detail?

 

[caccarazza]

I don’t know what you mean. Can you post an example or explain in more detail?

I'm trying to put the screenshot here, I give you the link https://ibb.co/d2RpXGP

I jus need a table 3x3 with 5 random alphanumerical numbers or letters

 

[lrobbo314]

Ok, how about this?

Sub Shulte()
Dim AR(1 To 3, 1 To 3)
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim SQ As Object: Set SQ = CreateObject("System.Collections.ArrayList")
Dim Board As Range
Dim r As Integer, Rounds As Integer


Set Board = Range("A1").Resize(UBound(AR), UBound(AR, 2))
For Rounds = 1 To 10
    For i = 65 To 90
        If i < 65 + (UBound(AR) * UBound(AR, 2)) Then
            AL.Add i - 64
            SQ.Add i - 64
        End If
        AL.Add Chr(i)
    Next i
    For j = 1 To UBound(AR)
        For k = 1 To UBound(AR, 2)
            r = Int((AL.Count - 1) * Rnd + 1)
            AR(j, k) = AL(r)
            AL.removeat r
        Next k
    Next j


        
    Board.Font.ColorIndex = 0
    Board.Value = AR
    For l = 1 To 4
        r = Int((SQ.Count - 1) * Rnd + 1)
        Board.Cells(SQ(r)).ClearContents
        SQ.removeat r
    Next l
    Application.Wait Now() + TimeValue("0:00:01")
    Board.Font.ColorIndex = 2
    Application.Wait Now() + TimeValue("0:00:07")
    AL.Clear
    DoEvents
Next Rounds
End Sub

 

[caccarazza]

yes, thank you very much, it is perfect now, ok the numbers are less cause are fm 1 to 9 and the alphabet from A to Z, but it's ok.... many thanks

 

[lrobbo314]

If it’s an issue, I can amend to code to have a more even distribution, but if it’s good as is, then I’m glad it works for you. Good luck on the speed reading.

 

[caccarazza]

Don't worry, it's not a issue... thank you !