Extracting VBA from: Alpha.xls
Contains VBA: True

============================================================
--- ThisWorkbook.cls ---
============================================================
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


============================================================
--- Sheet6.cls ---
============================================================
Attribute VB_Name = "Sheet6"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


============================================================
--- Sheet2.cls ---
============================================================
Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


============================================================
--- Sheet5.cls ---
============================================================
Attribute VB_Name = "Sheet5"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


============================================================
--- Module1.bas ---
============================================================
Attribute VB_Name = "Module1"
Option Explicit
Sub randomise()
'
' Macro1 Macro
' Macro recorded 21/07/2005 by Brown
'

Dim S As Integer
Dim K As Integer
Dim Reps As Integer
Dim nTreat As Integer
Dim nControl As Integer
Dim Counter1 As Integer
Dim Counter2 As Integer
Dim Counter3 As Integer
Dim Counter4 As Integer
Dim Counter5 As Integer
Dim Rotation As Integer
Dim DesignRow As Integer
Dim ChooseCell As Integer
Dim Bill As Integer
Dim Ben As Integer
Dim Response As Integer
Dim LayTop As Integer
Dim LayBot As Integer
Dim LisTop As Integer
Dim LisBot As Integer
Dim RankSet As Range
Dim TreatName As Range
Dim ControlName As Range
Dim TreatRange As Range
Dim c As Range
Dim RepString As String

Application.ScreenUpdating = False

' Set up design
Worksheets("Choose design").Activate
S = Range("F15").Value
K = Range("F16").Value
Reps = Range("F17").Value
nTreat = Range("F14").Value
Worksheets("Describe experiment").Activate
nControl = Range("B10")
Set TreatName = Range("B23", Cells(nTreat + 22, 3))
If nControl > 0 Then Set ControlName = Range("E23", Cells(nControl + 22, 6))
If nTreat < 100 Then Range(Cells(23 + nTreat, 3), Cells(122, 3)).ClearContents
If nControl < 6 Then Range(Cells(23 + nControl, 6), Cells(28, 6)).ClearContents
With ActiveWindow
    .ScrollRow = 1
    .ScrollColumn = 1
End With
If S < Range("H23").Value Or S > Cells(23, 8).Offset(Cells(21, 8).Value - 1, 0).Value Then
    Range("B17").Select
    Application.ScreenUpdating = True
    ActiveWindow.LargeScroll Down:=1
    ActiveWindow.LargeScroll Up:=1
    Response = MsgBox("Choose blocks/rep from list", 0, "Edgar II")
Else
    Range("B7").Select
    If Range("B13") = "" Then
        RepString = "Rep"
    Else
        RepString = Range("B13")
    End If
    Range("B7").Select
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With

' Set up design list sheet
Worksheets("Design, list").Activate
Range("A3") = "x"
Range("A3", Range("A3").SpecialCells(xlLastCell)).EntireRow.Delete
Cells.Borders.LineStyle = xlNone
Range("A3").Formula = "=""Experiment: ""&'Describe experiment'!B7"
Range("A4").Formula = "=""Designed: ""&'Describe experiment'!A3"
Range("A3", "A4").Copy
Range("A3", "A4").PasteSpecial xlPasteValues
With Rows("3:4")
    .Font.Name = "Arial"
    .Font.Size = 12
    .RowHeight = 15
End With
' Random numbers and treatments
TreatName.Copy
Worksheets("Design, list").Range("A7").PasteSpecial Paste:=xlPasteValues
Set TreatRange = Range(Cells(7, 2), Cells(nTreat + 6, 2))
Counter1 = 0
For Each c In TreatRange
    Counter1 = Counter1 + 1
    If c = "" Then c = Counter1
Next c
If nControl > 0 Then
    ControlName.Copy
    Worksheets("Design, list").Range("C7").PasteSpecial Paste:=xlPasteValues
    Set TreatRange = Range(Cells(7, 4), Cells(nControl + 6, 4))
    Counter1 = 0
    For Each c In TreatRange
        Counter1 = Counter1 + 1
        If c = "" Then c = Counter1
    Next c
End If
' Randomise allocation of treatments to treatment numbers (not controls)
Range("E7") = 1
With Range("E8", Cells(6 + nTreat, 5))
    .FormulaR1C1 = "=R[-1]C+1"
    .Copy
    .PasteSpecial xlPasteValues
End With
For Counter1 = 1 To nTreat
    Cells(6 + Counter1, 6) = Rnd
Next Counter1
Range("E7", Cells(6 + nTreat, 6)).Sort key1:=Cells(7, 6), order1:=xlAscending, header:=xlNo, Orientation:=xlTopToBottom
Range("E7", Cells(6 + nTreat, 5)).Copy
Range("A7").PasteSpecial xlPasteValues
Range("A7", Cells(6 + nTreat, 2)).Sort key1:=Cells(7, 1), order1:=xlAscending, header:=xlNo, Orientation:=xlTopToBottom

' Set up layout sheet
Worksheets("Design, layout").Activate
Columns.ColumnWidth = 8.43
Range("A3") = "x"
Range("A3", Range("A3").SpecialCells(xlLastCell)).EntireRow.Delete
Cells.Borders.LineStyle = xlNone
Worksheets("Design, list").Activate
Range("A3", "A4").Copy
Worksheets("Design, layout").Activate
Range("A3").PasteSpecial xlPasteAll
' Put values into first rep
If nControl > 0 Then
    Worksheets("Design, list").Activate
    Range("D7", Cells(6 + nControl, 4)).Copy
    Worksheets("Design, layout").Activate
    Range("C9", Cells(8 + nControl, 2 + S)).PasteSpecial xlPasteValues
End If
Counter3 = 0
Do Until Counter3 = nTreat
    For Counter1 = 1 To K
        For Counter2 = 1 To S
            Counter3 = Counter3 + 1
            Cells(Counter1 + 8 + nControl, Counter2 + 2) = Worksheets("Design, list").Range("B6").Offset(Counter3, 0)
            If Counter3 = nTreat Then Exit Do
        Next Counter2
    Next Counter1
Loop
' Design for subsequent reps
For Counter1 = 1 To Reps - 1 ' Counter1 counts reps
    Range(Cells(9, 3), Cells(9 + nControl, S + 2)).Copy
    Cells(Counter1 * (K + nControl + 2) + 9, 3).PasteSpecial xlPasteValues
    For Counter2 = 2 To K
        Worksheets("Choose design").Activate
        DesignRow = Range("I1").Value
        Rotation = Cells(DesignRow + Counter1, Counter2 + 10)
        Worksheets("Design, layout").Activate
        For Counter3 = 1 To S
            ChooseCell = ((Counter3 - 1 + Rotation) Mod S) + 1
            Cells(Counter2 + Counter1 * (K + 2 + nControl) + 8 + nControl, Counter3 + 2) = _
                Cells(Counter2 + nControl + 8, ChooseCell + 2)
        Next Counter3
    Next Counter2
Next Counter1
' Randomise within blocks
For Counter1 = 1 To Reps
    For Counter2 = 1 To S
        Bill = 9 + (Counter1 - 1) * (nControl + K + 2)
        Ben = 7 + Counter1 * (K + nControl + 1) + Counter1
        Range(Cells(Bill, Counter2 + 2), Cells(Ben, Counter2 + 2)).Copy
        Cells(Bill, S + 4).PasteSpecial xlPasteValues
        With Range(Cells(Bill, S + 5), Cells(Ben, S + 5))
            .Formula = "=if(RC[-1]="""","""",rand())"
            .Copy
            .PasteSpecial xlPasteValues
        End With
        Range(Cells(Bill, S + 4), Cells(Ben, S + 5)).Sort _
            key1:=Cells(Bill, S + 5), order1:=xlAscending, _
            header:=xlNo, MatchCase:=False, Orientation:=xlTopToBottom
        Range(Cells(Bill, S + 4), Cells(Ben, S + 4)).Copy
        Cells(Bill, Counter2 + 2).PasteSpecial xlPasteValues
    Next Counter2
Next Counter1

' Tidy up layout sheet
' Table headers
Rows("6:8").Font.Bold = True
For Counter2 = 1 To Reps
    For Counter1 = 1 To S
        Cells(8 + (Counter2 - 1) * (nControl + K + 2), Counter1 + 2) = Counter1
    Next Counter1
    Rows(8 + (Counter2 - 1) * (nControl + K + 2)).Font.Bold = True
    For Counter1 = 1 To K + nControl
        Cells(8 + Counter1 + (Counter2 - 1) * (nControl + K + 2), 2) = Counter1
    Next Counter1
    Cells(8 + (Counter2 - 1) * (nControl + K + 2), 2).Formula = "=IF('Describe experiment'!B19="""",""Plot"",'Describe experiment'!B19)"
    Cells(7 + (Counter2 - 1) * (nControl + K + 2), 2).Formula = RepString & " " & Counter2
Next Counter2
' Column widths
Range("B8", Cells(8, S + 2)).EntireColumn.AutoFit
For Counter1 = 1 To S + 1
    Columns(Counter1).ColumnWidth = Columns(Counter1 + 1).ColumnWidth + 6
Next Counter1
' Get rid of cells to left
Range("B6", Cells(Reps * (nControl + K + 2) + 6, S + 2)).Copy
Range("A6").PasteSpecial xlPasteValues
' Get rid of unwanted columns
Range(Cells(8, S + 2), Cells(8, S + 2).SpecialCells(xlLastCell)).EntireColumn.Delete
' Alignment
Range(Cells(8, 1), Cells(8 + (nControl + K + 2), S + 1)).HorizontalAlignment = xlCenter
Range(Cells(6, 1), Cells(7, 1)).HorizontalAlignment = xlLeft
' Summary table headers
Cells(6, 1).Formula = "=IF('Describe experiment'!B9="""",""Variety"",'Describe experiment'!B9)"
For Counter1 = 1 To Reps
    Counter3 = 7 + (Counter1 - 1) * (nControl + K + 2)
    Cells(Counter3, 2).Formula = "=IF('Describe experiment'!B16="""",""Block"",'Describe experiment'!B16)"
    With Range(Cells(Counter3, 1), Cells(Counter3, 2))
        .HorizontalAlignment = xlLeft
        .Font.Bold = True
    End With
Next Counter1
' PasteSpecial values
With Range("A6", Cells(6 + Reps * (nControl + K + 2), S + 1))
    .Copy
    .PasteSpecial xlPasteValues
End With
' Borders
With Range("A7", Cells(6 + Reps * (nControl + K + 2), S + 1)).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
For Counter1 = 1 To Reps
    Counter2 = (Counter1 - 1) * (nControl + K + 2) + 7
    With Range(Cells(Counter2, 1), Cells(Counter2, S + 1))
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlInsideVertical).LineStyle = xlNone
    End With
    Range(Cells(Counter2 + 1, 1), Cells(Counter2 + 1, S + 1)).Borders(xlEdgeBottom).Weight = xlMedium
Next Counter1
Counter1 = 6 + Reps * (nControl + K + 2)
Range("A7", Cells(Counter1, 1)).Borders(xlEdgeRight).Weight = xlMedium
Range(Cells(Counter1, 1), Cells(Counter1, S + 1)).Borders(xlEdgeBottom).Weight = xlThick
' Finish
With ActiveSheet.PageSetup
    .PrintTitleRows = "$2:$6"
    .PrintTitleColumns = ""
    .CenterFooter = "Page &P of &N"
End With
Range("D1").Select
With ActiveWindow
    .ScrollRow = 1
    .ScrollColumn = 1
End With

' List sheet
' Clear the gubbins
Worksheets("Design, list").Activate
Range(Cells(7, 2), Cells(7, 2).SpecialCells(xlLastCell)).EntireColumn.Delete
Range(Cells(7, 1), Cells(7, 1).SpecialCells(xlLastCell)).EntireRow.Delete
' Headers
Range("B6") = "Unit"
Range("C6") = RepString
Range("D6") = Worksheets("Design, layout").Range("B7")
Range("E6") = Worksheets("Design, layout").Range("A8")
Range("F6") = Worksheets("Design, layout").Range("A6")
With Range("B6", Cells(6 + S * (K + nControl) * Reps, 6)).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Range("A6", "F6")
    .Font.Bold = True
    .Borders(xlEdgeTop).Weight = xlThick
    .Borders(xlEdgeBottom).Weight = xlMedium
End With
' Reps, blocks, plots and treatments
Range("E7", Cells(6 + S * (K + nControl) * Reps, 5)).FormulaR1C1 = "=R[-1]C+1"
For Counter1 = 1 To Reps
    LayTop = 9 + (Counter1 - 1) * (nControl + K + 2)
    LayBot = 8 + Counter1 * (nControl + K + 2)
    Counter3 = 0
    For Counter2 = 1 To S
        LisTop = 7 + (Counter1 - 1) * S * (K + nControl) + (Counter2 - 1) * (K + nControl)
        LisBot = 6 + (Counter1 - 1) * S * (K + nControl) + Counter2 * (K + nControl)
        Worksheets("Design, layout").Activate
        Range(Cells(LayTop, Counter2 + 1), Cells(LayBot, Counter2 + 1)).Copy
        Worksheets("Design, list").Activate
        Cells(LisTop, 6).PasteSpecial xlPasteValues
        Range(Cells(LisTop, 3), Cells(LisBot, 3)) = Counter1
        Range(Cells(LisTop, 4), Cells(LisBot, 4)) = Counter2
        Cells(LisTop, 5) = 1
        Range(Cells(LisBot + 1, 2), Cells(LisBot + 1, 6)).Borders(xlEdgeTop).Weight = xlMedium
    Next Counter2
    Range(Cells(LisBot + 1, 2), Cells(LisBot + 1, 5)).Borders(xlEdgeTop).Weight = xlThick
Next Counter1
For Counter1 = S * (K + nControl) * Reps + 6 To 7 Step -1
    If Cells(Counter1, 6) = "" Then Cells(Counter1, 6).EntireRow.Delete
Next Counter1
Range("B7") = 1
Range("B8", Range("C7").End(xlDown).Offset(0, -1)).FormulaR1C1 = "=R[-1]C+1"
Range("B6").End(xlDown).Offset(1, 0) = "x"
Range(Range("B6").End(xlDown), Range("B6").End(xlDown).SpecialCells(xlLastCell)).EntireRow.Delete
Range(Range("B6").End(xlDown), Range("B6").End(xlDown).End(xlToRight)).Borders(xlEdgeBottom).Weight = xlThick
' Column widths
With Range("B6", Range("B6").End(xlDown).End(xlToRight))
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlCenter
    .Copy
    .PasteSpecial xlPasteValues
End With
For Counter1 = 1 To 5
    Columns(Counter1).ColumnWidth = Columns(Counter1 + 1).ColumnWidth + 6
Next Counter1
' Remove unwanted column
Range("A6", Range("B6").End(xlDown).Offset(0, -1)).Delete

' Finish
With ActiveSheet.PageSetup
    .PrintTitleRows = "$2:$6"
    .PrintTitleColumns = ""
    .CenterFooter = "Page &P of &N"
End With
Range("D1").Select
With ActiveWindow
    .ScrollRow = 1
    .ScrollColumn = 1
End With
Application.ScreenUpdating = True
ActiveWindow.LargeScroll Down:=1
ActiveWindow.LargeScroll Up:=1
Response = MsgBox("Now save this spreadsheet!", 0, "Edgar II")
    
End If

End Sub


============================================================
--- Sheet4.cls ---
============================================================
Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


