[COLOR="Navy"]Sub[/COLOR] MG23Apr12
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] RndRw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] col [COLOR="Navy"]As[/COLOR] Range, nCol [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] cRng [COLOR="Navy"]As[/COLOR] Range, p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2:A7")
Range("F1:J5").ClearContents
Randomize
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
n = 0
[COLOR="Navy"]Do[/COLOR] Until n >= Dn.Offset(, 1).Value
txt = "": c = 0
RndRw = Application.RandBetween(1, 5)
p = p + 1
[COLOR="Navy"]If[/COLOR] p >= 10000 [COLOR="Navy"]Then[/COLOR] GoTo xt
[COLOR="Navy"]If[/COLOR] Not Application.CountA(Cells(RndRw, 6).Resize(, 5)) = 5 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] R = Cells(RndRw, 6).Resize(, 5).SpecialCells(xlCellTypeBlanks)
txt = Join(Application.Transpose(Application.Transpose(Cells(RndRw, 6).Resize(, 5))), ",")
[COLOR="Navy"]If[/COLOR] InStr(txt, Dn.Value) = 0 [COLOR="Navy"]Then[/COLOR]
ReDim Ray(1 To R.Count)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] col [COLOR="Navy"]In[/COLOR] R
c = c + 1
Ray(c) = col.Column
[COLOR="Navy"]Next[/COLOR] col
Num = Application.RandBetween(1, UBound(Ray))
Cells(RndRw, Ray(Num)) = Dn
n = n + 1
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Loop[/COLOR]
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Range("F1:J5")
.SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Borders.Weight = xlThick
[COLOR="Navy"]End[/COLOR] With
MsgBox "Success!!"
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
xt:
MsgBox "Not Computable, Try again"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]