Extracting VBA from: Latin.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


============================================================
--- 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



============================================================
--- 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"
Public NoWorries As Boolean
Option Explicit
Sub randomise()
'
' Macro1 Macro
' Macro recorded 21/07/2005 by Brown
'

Dim nRow As Integer
Dim nCol As Integer
Dim nRep 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
Randomize

' Set up design
Worksheets("Describe experiment").Activate
nTreat = Range("B10").Value
nRow = Range("B13").Value
nCol = Range("B16").Value
NoWorries = True
If nTreat < 2 Or nTreat > 100 Then
    Range("B10").Select
    SuddenStop
    Response = MsgBox("Between 2 and 100 treatments", 0, "Edgar II")
End If
If NoWorries And (nRow Mod nTreat <> 0 Or nRow = 0) Then
    Range("B13").Select
    SuddenStop
    Response = MsgBox("Number of rows must be multiple" & Chr(13) & " of number of treatments", 0, "Edgar II")
End If
If NoWorries And (nCol Mod nTreat <> 0 Or nCol = 0) Then
    Range("B16").Select
    SuddenStop
    Response = MsgBox("Number of columns must be multiple" & Chr(13) & " of number of treatments", 0, "Edgar II")
End If
If Not NoWorries Then
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    Application.ScreenUpdating = True
    With ActiveWindow
        .LargeScroll Down:=1
        .LargeScroll Up:=1
    End With
Else

' Start the programme in earnest

nRep = nRow * nCol / nTreat / nTreat
Set TreatName = Range("B21", Cells(nTreat + 20, 3))
If nTreat < 100 Then Range(Cells(21 + nTreat, 3), Cells(120, 3)).ClearContents
Range("B7").Select
If Range("B18") = "" Then
    RepString = "Square"
Else
    RepString = Range("B18")
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

' 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
Range("A3", "A4").Copy
Range("A3").PasteSpecial xlPasteValues

' Set up first square
Worksheets("Design, list").Activate
Range("B7", Cells(6 + nTreat, 2)).Copy
Worksheets("Design, layout").Activate
For Counter1 = 1 To nTreat
    Cells(8 + Counter1, 2 + Counter1).PasteSpecial xlPasteValues
Next Counter1
Range(Cells(9 + nTreat, 4), Cells(7 + 2 * nTreat, 2 + nTreat)).Copy
Cells(9, 4).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Range(Cells(9 + nTreat, 4), Cells(7 + 2 * nTreat, 2 + nTreat)).ClearContents

' Design for subsequent reps
For Counter1 = 1 To nRep - 1 ' Counter1 counts reps
    Range(Cells(9, 3), Cells(8 + nTreat, nTreat + 2)).Copy
    Cells(Counter1 * (nTreat + 2) + 9, 3).PasteSpecial xlPasteValues
Next Counter1

' Randomise rows
For Counter1 = 1 To nRep
    For Counter2 = 1 To nTreat
        Cells(8 + Counter2 + (Counter1 - 1) * (nTreat + 2), 2) = Rnd
    Next Counter2
    Range(Cells(9 + (Counter1 - 1) * (nTreat + 2), 2), Cells(8 + nTreat + (Counter1 - 1) * (nTreat + 2), 2 + nTreat)).Sort _
            key1:=Cells(9 + (Counter1 - 1) * (nTreat + 2), 2), order1:=xlAscending, _
            header:=xlNo, MatchCase:=False, Orientation:=xlTopToBottom
    Range(Cells(9 + (Counter1 - 1) * (nTreat + 2), 2), Cells(8 + nTreat + (Counter1 - 1) * (nTreat + 2), 2)).ClearContents
Next Counter1
' Randomise columns
For Counter1 = 1 To nRep
    For Counter2 = 1 To nTreat
        Cells(8 + (Counter1 - 1) * (nTreat + 2), 2 + Counter2) = Rnd
    Next Counter2
    Range(Cells(8 + (Counter1 - 1) * (nTreat + 2), 3), Cells(8 + nTreat + (Counter1 - 1) * (nTreat + 2), 2 + nTreat)).Sort _
            key1:=Cells(8 + (Counter1 - 1) * (nTreat + 2), 2 + Counter2), order1:=xlAscending, _
            header:=xlNo, MatchCase:=False, Orientation:=xlLeftToRight
    Range(Cells(8 + (Counter1 - 1) * (nTreat + 2), 3), Cells(8 + (Counter1 - 1) * (nTreat + 2), 2 + nTreat)).ClearContents
Next Counter1
' Tidy up layout sheet
' Table headers
Rows("6:8").Font.Bold = True
For Counter2 = 1 To nRep
    For Counter1 = 1 To nTreat
        Cells(8 + (Counter2 - 1) * (nTreat + 2), Counter1 + 2) = Counter1
    Next Counter1
    Rows(7 + (Counter2 - 1) * (nTreat + 2)).Font.Bold = True
    Rows(8 + (Counter2 - 1) * (nTreat + 2)).Font.Bold = True
    For Counter1 = 1 To nTreat
        Cells(8 + Counter1 + (Counter2 - 1) * (nTreat + 2), 2) = Counter1
    Next Counter1
    Cells(8 + (Counter2 - 1) * (nTreat + 2), 2).Formula = "=IF('Describe experiment'!B12="""",""Row"",'Describe experiment'!B12)"
    Cells(7 + (Counter2 - 1) * (nTreat + 2), 3).Formula = "=IF('Describe experiment'!B15="""",""Column"",'Describe experiment'!B15)"
    Cells(7 + (Counter2 - 1) * (nTreat + 2), 2).Formula = RepString & " " & Counter2
Next Counter2
' Column widths
Range("B8", Cells(8, nTreat + 2)).EntireColumn.AutoFit
For Counter1 = 1 To nTreat + 1
    Columns(Counter1).ColumnWidth = Columns(Counter1 + 1).ColumnWidth + 6
Next Counter1
' Get rid of cells to left
Range("B7", Cells(nRep * (nTreat + 2) + 6, nTreat + 2)).Copy
Range("A7").PasteSpecial xlPasteValues
' Get rid of unwanted columns
Range(Cells(8, nTreat + 2), Cells(8, nTreat + 2).SpecialCells(xlLastCell)).EntireColumn.Delete
' Alignment
Range(Cells(8, 1), Cells(8 + (nTreat + 2), nTreat + 1)).HorizontalAlignment = xlCenter
With Cells(6, 1)
    .HorizontalAlignment = xlLeft
    .Formula = "=IF('Describe experiment'!B9="""",""Variety"",'Describe experiment'!B9)"
End With
For Counter1 = 1 To nRep
    Counter3 = 7 + (Counter1 - 1) * (nTreat + 2)
    With Range(Cells(Counter3, 1), Cells(Counter3, 2))
        .HorizontalAlignment = xlLeft
        .Font.Bold = True
    End With
Next Counter1
' PasteSpecial values
With Range("A6", Cells(6 + nRep * (nTreat + 2), nTreat + 1))
    .Copy
    .PasteSpecial xlPasteValues
End With
' Borders
With Range("A7", Cells(6 + nRep * (nTreat + 2), nTreat + 1)).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
For Counter1 = 1 To nRep
    Counter2 = (Counter1 - 1) * (nTreat + 2) + 7
    With Range(Cells(Counter2, 1), Cells(Counter2, nTreat + 1))
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlInsideVertical).LineStyle = xlNone
    End With
    Range(Cells(Counter2 + 1, 1), Cells(Counter2 + 1, nTreat + 1)).Borders(xlEdgeBottom).Weight = xlMedium
Next Counter1
Counter1 = 6 + nRep * (nTreat + 2)
Range("A7", Cells(Counter1, 1)).Borders(xlEdgeRight).Weight = xlMedium
Range(Cells(Counter1, 1), Cells(Counter1, nTreat + 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 + nTreat * nTreat * nRep, 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("B7") = 1
Range("B8", Cells(6 + nTreat * nTreat * nRep, 2)).FormulaR1C1 = "=R[-1]C+1"
Range("E7", Cells(6 + nTreat * nTreat * nRep, 5)).FormulaR1C1 = "=R[-1]C+1"
For Counter1 = 1 To nRep
    LayTop = 9 + (Counter1 - 1) * (nTreat + 2)
    LayBot = 8 + Counter1 * (nTreat + 2)
    Counter3 = 0
    For Counter2 = 1 To nTreat
        LisTop = 7 + (Counter1 - 1) * nTreat * nTreat + (Counter2 - 1) * nTreat
        LisBot = 6 + (Counter1 - 1) * nTreat * nTreat + Counter2 * nTreat
        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, 6)).Borders(xlEdgeTop).Weight = xlThick
Next Counter1
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
Sub SuddenStop()
    Application.ScreenUpdating = True
    ActiveWindow.LargeScroll Down:=1
    ActiveWindow.LargeScroll Up:=1
    NoWorries = False
End Sub

