hi,

i desperately need your help. im trying to generate lists of of 240
experimental trials.

there are three trial types (each trial type has an associated
probability of occurrence).

what i have done so far is i have used the discrete randomisation to
generate 100 lists of 240 trials each (one column for each block, all
blocks on a separate sheet). i have also gotten the macro to calculate
the probability of occurrence of each trial type within each of the 100
generated blocks.

now i need to censor those lists in the following ways:

1. eliminate blocks that have 4 or more of the same trial type in a
row
2. eliminate blocks in which the trial type probability falls outside a
specified range.

any help at all would be hugely appreciated. i am really struggling
here. thank you so much.


--
clulesacademic
------------------------------------------------------------------------
clulesacademic's Profile: http://www.excelforum.com/member.php...o&userid=31368
View this thread: http://www.excelforum.com/showthread...hreadid=510608

Sub Checkcolumns
Dim v1 as Variant, v as Variant
Dim i as Long, rng as Range, cnt as Long
dim cntv(1 to 3) as Long, j as long
Dim k as Long, kk as Long

' enter the values that idicate which trial type
v1 = Array("type1","type2","type3")
' enter corresponding probabilities/proportions
v2 = Array(.35, .25, .40)

k = lbound(v1)

for i = 100 to 1 step -1
set rng = range(cells(1,1),cells(1,1).End(xldown))
v = rng.Value

cnt = 0
for i = 1 to rng.count
j= 0
for kk = k to ubound(v1)
j = j + 1
if v(i,1) = v1(k) then cntv(j) = cntv(j) + 1
exit for
Next
if i < 1 then
if v(i,1) = v(i-1,1) then
cnt = cnt + 1
else
cnt = 1
end if
if cnt = 4 then
columns(i).Delete
exit for
end if
End if
Next
if Abs((cntv(k)/rng.count)-v2(k)) .05 or _
Abs((cntv(k+1)/rng.count)-v2(k+1)) .05 or _
Abs((cntv(k+2)/rng.count)-v2(k+2)) .05 then
columns(i).Delete
end if
Next
End Sub

Untested code, so may contain typos or other errors.

--
Regards,
Tom Ogilvy


"clulesacademic"
wrote in
message news:clulesacademic.22yxwp_1139499605.322@excelfor um-nospam.com...

hi,

i desperately need your help. im trying to generate lists of of 240
experimental trials.

there are three trial types (each trial type has an associated
probability of occurrence).

what i have done so far is i have used the discrete randomisation to
generate 100 lists of 240 trials each (one column for each block, all
blocks on a separate sheet). i have also gotten the macro to calculate
the probability of occurrence of each trial type within each of the 100
generated blocks.

now i need to censor those lists in the following ways:

1. eliminate blocks that have 4 or more of the same trial type in a
row
2. eliminate blocks in which the trial type probability falls outside a
specified range.

any help at all would be hugely appreciated. i am really struggling
here. thank you so much.


--
clulesacademic
------------------------------------------------------------------------
clulesacademic's Profile:
http://www.excelforum.com/member.php...o&userid=31368
View this thread: http://www.excelforum.com/showthread...hreadid=510608

forgot to initialize my counters and had 1's instead of an i's in my set
rng line.

Sub Checkcolumns
Dim v1 as Variant, v as Variant
Dim i as Long, rng as Range, cnt as Long
dim cntv(1 to 3) as Long, j as long
Dim k as Long, kk as Long

' enter the values that idicate which trial type
v1 = Array("type1","type2","type3")
' enter corresponding probabilities/proportions
v2 = Array(.35, .25, .40)

k = lbound(v1)

for i = 100 to 1 step -1
set rng = range(cells(1,i),cells(1,i).End(xldown))
v = rng.Value

cnt = 0
for j = k to ubound(v1)
cntv(j) = 0
Next
for i = 1 to rng.count
j= 0
for kk = k to ubound(v1)
j = j + 1
if v(i,1) = v1(k) then cntv(j) = cntv(j) + 1
exit for
Next
if i < 1 then
if v(i,1) = v(i-1,1) then
cnt = cnt + 1
else
cnt = 1
end if
if cnt = 4 then
columns(i).Delete
exit for
end if
End if
Next
if Abs((cntv(k)/rng.count)-v2(k)) .05 or _
Abs((cntv(k+1)/rng.count)-v2(k+1)) .05 or _
Abs((cntv(k+2)/rng.count)-v2(k+2)) .05 then
columns(i).Delete
end if
Next
End Sub

Untested code, so may contain typos or other errors.

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Sub Checkcolumns
Dim v1 as Variant, v as Variant
Dim i as Long, rng as Range, cnt as Long
dim cntv(1 to 3) as Long, j as long
Dim k as Long, kk as Long

' enter the values that idicate which trial type
v1 = Array("type1","type2","type3")
' enter corresponding probabilities/proportions
v2 = Array(.35, .25, .40)

k = lbound(v1)

for i = 100 to 1 step -1
set rng = range(cells(1,1),cells(1,1).End(xldown))
v = rng.Value

cnt = 0
for i = 1 to rng.count
j= 0
for kk = k to ubound(v1)
j = j + 1
if v(i,1) = v1(k) then cntv(j) = cntv(j) + 1
exit for
Next
if i < 1 then
if v(i,1) = v(i-1,1) then
cnt = cnt + 1
else
cnt = 1
end if
if cnt = 4 then
columns(i).Delete
exit for
end if
End if
Next
if Abs((cntv(k)/rng.count)-v2(k)) .05 or _
Abs((cntv(k+1)/rng.count)-v2(k+1)) .05 or _
Abs((cntv(k+2)/rng.count)-v2(k+2)) .05 then
columns(i).Delete
end if
Next
End Sub

Untested code, so may contain typos or other errors.

--
Regards,
Tom Ogilvy


"clulesacademic"
wrote in
message news:clulesacademic.22yxwp_1139499605.322@excelfor um-nospam.com...

hi,

i desperately need your help. im trying to generate lists of of 240
experimental trials.

there are three trial types (each trial type has an associated
probability of occurrence).

what i have done so far is i have used the discrete randomisation to
generate 100 lists of 240 trials each (one column for each block, all
blocks on a separate sheet). i have also gotten the macro to calculate
the probability of occurrence of each trial type within each of the 100
generated blocks.

now i need to censor those lists in the following ways:

1. eliminate blocks that have 4 or more of the same trial type in a
row
2. eliminate blocks in which the trial type probability falls outside a
specified range.

any help at all would be hugely appreciated. i am really struggling
here. thank you so much.


--
clulesacademic
------------------------------------------------------------------------
clulesacademic's Profile:
http://www.excelforum.com/member.php...o&userid=31368
View this thread:
http://www.excelforum.com/showthread...hreadid=510608

thanks tom,

its giving me an error... it says. "compile error: For control
variable already in use".

its at this point in the code:

...
cnt = 0
For j = k To UBound(v1)
cntv(j) = 0
Next
*For i = 1 To rng.Count*
j = 0
For kk = k To UBound(v1)
j = j + 1
If v(i, 1) = v1(k) Then cntv(j) = cntv(j) + 1
Exit For
Next
If i < 1 Then
If v(i, 1) = v(i - 1, 1) Then
cnt = cnt + 1
Else
cnt = 1
End If
If cnt = 4 Then
Columns(i).Delete
Exit For
End If
End If
Next
If Abs((cntv(k) / rng.Count) - v2(k)) 0.05 Or _
Abs((cntv(k + 1) / rng.Count) - v2(k + 1)) 0.05 Or _
Abs((cntv(k + 2) / rng.Count) - v2(k + 2)) 0.05 Then
Columns(i).Delete
End If
Next
End Sub

i looked up the help on the error, but dont really understand how that
could be avoided. thanks again!


--
clulesacademic
------------------------------------------------------------------------
clulesacademic's Profile: http://www.excelforum.com/member.php...o&userid=31368
View this thread: http://www.excelforum.com/showthread...hreadid=510608

Ok, I tested it and worked out the bugs i found:

I found almost every column had at least one set of 4 adjacent cells that
included the same type. So you might want to use a number higher than 4 -
perhaps 7.

Sub Checkcolumns()
Dim v1 As Variant, v As Variant
Dim i As Long, rng As Range, cnt As Long
Dim cntv() As Long, j As Long
Dim k As Long, kk As Long, ii As Long
Dim jj As Long, bDelete As Boolean

' enter the values that idicate which trial type
v1 = Array("type1", "type2", "type3")
' enter corresponding probabilities/proportions
v2 = Array(0.35, 0.25, 0.4)

k = LBound(v1)
ReDim cntv(k To k + 2)
For ii = 100 To 1 Step -1
Set rng = Range(Cells(1, ii), Cells(1, ii).End(xlDown))
v = rng.Value
Max = 0
cnt = 0
bDelete = False
For j = k To UBound(v1)
cntv(j) = 0
Next
For i = 1 To rng.Count
For kk = k To UBound(v1)
If v(i, 1) = v1(kk) Then
cntv(kk) = cntv(kk) + 1
Exit For
End If
Next
If i < 1 Then
If v(i, 1) = v(i - 1, 1) Then
cnt = cnt + 1
If cnt Max Then Max = cnt
Else
cnt = 1
End If
If cnt = 4 Then
'Cells(1, ii).Interior.ColorIndex = 3
Debug.Print ii, "count"
bDelete = True
Columns(ii).Delete
Exit For
End If
End If
Next
' Cells(2, ii) = cntv(k)
' Cells(3, ii) = cntv(k + 1)
' Cells(4, ii) = cntv(k + 2)
If Not bDelete Then
If Abs((cntv(k) / rng.Count) - v2(k)) 0.05 Or _
Abs((cntv(k + 1) / rng.Count) - v2(k + 1)) 0.05 Or _
Abs((cntv(k + 2) / rng.Count) - v2(k + 2)) 0.05 Then
Debug.Print ii, "percent"
Columns(ii).Delete
' If Abs((cntv(k) / rng.Count) - v2(k)) 0.05 Then Cells(2,
ii).Interior.ColorIndex = 3
' If Abs((cntv(k + 1) / rng.Count) - v2(k + 1)) 0.05 Then Cells(3,
ii).Interior.ColorIndex = 3
' If Abs((cntv(k + 2) / rng.Count) - v2(k + 2)) 0.05 Then Cells(4,
ii).Interior.ColorIndex = 3
End If
' Cells(1, ii).Value = Max
End If
Next ii
End Sub

--
Regards,
Tom Ogilvy


"clulesacademic"
<clulesacademic.230bg1_1139563811.0245@excelforu m-nospam.com wrote in
message news:clulesacademic.230bg1_1139563811.0245@excelfo rum-nospam.com...

thanks tom,

its giving me an error... it says. "compile error: For control
variable already in use".

its at this point in the code:

..
cnt = 0
For j = k To UBound(v1)
cntv(j) = 0
Next
*For i = 1 To rng.Count*
j = 0
For kk = k To UBound(v1)
j = j + 1
If v(i, 1) = v1(k) Then cntv(j) = cntv(j) + 1
Exit For
Next
If i < 1 Then
If v(i, 1) = v(i - 1, 1) Then
cnt = cnt + 1
Else
cnt = 1
End If
If cnt = 4 Then
Columns(i).Delete
Exit For
End If
End If
Next
If Abs((cntv(k) / rng.Count) - v2(k)) 0.05 Or _
Abs((cntv(k + 1) / rng.Count) - v2(k + 1)) 0.05 Or _
Abs((cntv(k + 2) / rng.Count) - v2(k + 2)) 0.05 Then
Columns(i).Delete
End If
Next
End Sub

i looked up the help on the error, but dont really understand how that
could be avoided. thanks again!


--
clulesacademic
------------------------------------------------------------------------
clulesacademic's Profile:
http://www.excelforum.com/member.php...o&userid=31368
View this thread: http://www.excelforum.com/showthread...hreadid=510608

thanks again! i really appreciate it.


--
clulesacademic
------------------------------------------------------------------------
clulesacademic's Profile: http://www.excelforum.com/member.php...o&userid=31368
View this thread: http://www.excelforum.com/showthread...hreadid=510608