Extracting VBA from: SplitPlot.xls
Contains VBA: True

============================================================
--- Module1.bas ---
============================================================
Attribute VB_Name = "Module1"
Public NoWorries As Boolean
Option Explicit
Sub randomise()
'
' randomise Macro
' Macro recorded 31/10/2004 by Brown

    Dim TotalUnits As Long
    Dim TotalTreats As Integer
    Dim TotalMains As Integer
    Dim Counter1 As Integer
    Dim Counter2 As Integer
    Dim Response As Integer
    Dim nTreat1 As Range
    Dim nTreat2 As Range
    Dim nBlock As Range
    Dim c As Range
    Dim Treat1Name As Range
    Dim Treat2Name As Range
    Dim TreatRange As Range
    Dim TreatRangeAll As Range
    Application.ScreenUpdating = False
    
' Check errors in input
    Worksheets("Describe experiment").Activate
    Set nTreat1 = Range("B15")
    Set nTreat2 = Range("B20")
    Set nBlock = Range("B10")
    Set Treat1Name = Range("C23", Cells(nTreat1.Value + 22, 3))
    Set Treat2Name = Range("E23", Cells(nTreat2.Value + 22, 5))
    TotalTreats = nTreat1.Value * nTreat2.Value
    TotalUnits = TotalTreats * nBlock.Value
    TotalMains = nTreat1.Value * nBlock.Value
    Range("B7").Select
    NoWorries = True
    If nTreat1 < 2 Then
        Range("B15").Select
        SuddenStop
        Response = MsgBox("Minimum 2 treatments", 0, "Edgar II")
    End If
    If NoWorries And nTreat2 < 2 Then
        Range("B20").Select
        SuddenStop
        Response = MsgBox("Minimum 2 treatments", 0, "Edgar II")
    End If
    If NoWorries And nBlock < 1 Then
        Range("B10").Select
        SuddenStop
        Response = MsgBox("Minimum 1 block", 0, "Edgar II")
    End If
    If NoWorries And TotalUnits > 5000 Then
        SuddenStop
        Response = MsgBox("Max 5000 units in total", 0, "Edgar II")
    End If
    If NoWorries Then
    If nTreat1 < 100 Then Range(Cells(23 + nTreat1, 3), Cells(122, 3)).ClearContents
    If nTreat2 < 100 Then Range(Cells(23 + nTreat2, 5), Cells(122, 5)).ClearContents
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    
' Design sheet header
    Worksheets("Design, list").Activate
    Cells.Borders.LineStyle = xlNone
    Range("A3") = "x"
    Range("A3", Range("A3").SpecialCells(xlLastCell)).EntireRow.Delete
    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
' Structure of main plots
    Range("F7") = nTreat1.Value
    Range("D7").FormulaR1C1 = "=R[-1]C+1"
    Range("E7").FormulaR1C1 = "=int((RC4-1)/R7C6)+1"
    Range("D7:E7").Copy
    With Range("D7", Cells(TotalMains + 6, 5))
        .PasteSpecial xlPasteFormulas
        .Copy
        .PasteSpecial xlPasteValues
    End With
' Treatment 1
    Treat1Name.Copy
    Worksheets("Design, list").Range("H7").PasteSpecial Paste:=xlPasteValues
    Set TreatRange = Range("H7", Cells(nTreat1 + 6, 8))
    Counter1 = 0
    For Each c In TreatRange
        Counter1 = Counter1 + 1
        If c = "" Then c = Counter1
    Next c
    TreatRange.Copy
    Range("H7", Cells(TotalMains + 6, 8)).PasteSpecial xlPasteValues
    With Range("I7", Cells(TotalMains + 6, 9))
        .FormulaR1C1 = "=rand()+RC5"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    Range("H7", Cells(TotalMains + 6, 9)).Copy
    With Range("H7", Cells(TotalUnits + 6, 9))
        .PasteSpecial xlPasteValues
        .Sort Key1:=Range("I7"), Order1:=xlAscending, Header:=xlNo, MatchCase:=False, _
            Orientation:=xlTopToBottom
    End With
' Structure of sub-plots
    Range("E7") = nTreat2
    Range("G7").FormulaR1C1 = "=R[-1]C+1"
    Range("F7").FormulaR1C1 = "=int((RC7-1)/R7C5)+1"
    Range("F7:G7").Copy
    With Range("F7", Cells(TotalUnits + 6, 7))
        .PasteSpecial xlPasteFormulas
        .Copy
        .PasteSpecial xlPasteValues
    End With
    Range(("F7"), Cells(TotalUnits + 6, 7)).Copy
    Range("K7").PasteSpecial xlPasteValues
' Treatment 2
    Treat2Name.Copy
    Worksheets("Design, list").Range("J7").PasteSpecial Paste:=xlPasteValues
    Set TreatRange = Range("J7", Cells(nTreat2 + 6, 10))
    Counter1 = 0
    For Each c In TreatRange
        Counter1 = Counter1 + 1
        If c = "" Then c = Counter1
    Next c
    Set TreatRangeAll = Range("J7", Cells(TotalUnits + 6, 10))
    TreatRange.Copy
    TreatRangeAll.PasteSpecial xlPasteValues
    With Range("I7", Cells(TotalUnits + 6, 9))
        .FormulaR1C1 = "=rand()+RC6"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    With Range("I7", Cells(TotalUnits + 6, 10))
        .Sort Key1:=Range("I7"), Order1:=xlAscending, Header:=xlNo, MatchCase:=False, _
            Orientation:=xlTopToBottom
        .Copy
    End With
' Design
    Range("E7") = TotalTreats
    Range("E8") = nTreat1.Value
    Range("E9") = nTreat2.Value
    Range("F7").FormulaR1C1 = "=int((RC12-1)/R7C5)+1"
    Range("G7").FormulaR1C1 = "=(RC11-(RC6-1)*R8C5)"
    Range("I7").FormulaR1C1 = "=(RC12-(RC11-1)*R9C5)"
    Range("F7:G7").Copy
    With Range("F7", Cells(TotalUnits + 6, 7))
        .PasteSpecial xlPasteFormulas
        .Copy
        .PasteSpecial xlPasteValues
    End With
    Range("I7").Copy
    With Range("I7", Cells(TotalUnits + 6, 9))
        .PasteSpecial xlPasteFormulas
        .Copy
        .PasteSpecial xlPasteValues
    End With
' Tidy up Design columns
    Range("K7", Cells(TotalUnits + 6, 12)).ClearContents
    Range("E6") = "Unit"
    Range("F6").Formula = "=IF('Describe experiment'!B9="""",""Block"",proper('Describe experiment'!B9))"
    Range("G6").Formula = "=IF('Describe experiment'!B12="""",""Main plot"",proper('Describe experiment'!B12))"
    Range("H6").Formula = "=IF('Describe experiment'!B14="""",""MainTreat"",proper('Describe experiment'!B14))"
    Range("I6").Formula = "=IF('Describe experiment'!B17="""",""Sub-plot"",proper('Describe experiment'!B17))"
    Range("J6").Formula = "=IF('Describe experiment'!B19="""",""SubTreat"",proper('Describe experiment'!B19))"
    Range("E7") = 1
    With Range("E8", Cells(TotalUnits + 6, 5))
        .FormulaR1C1 = "=R[-1]C+1"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    Rows("6:6").Font.Bold = True
    With Rows("3:6")
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With
    With Columns("E:J")
        .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
    End With
    Columns("A:A").ColumnWidth = Columns("E:E").ColumnWidth + 6
    Columns("B:B").ColumnWidth = Columns("F:F").ColumnWidth + 6
    Columns("C:C").ColumnWidth = Columns("G:G").ColumnWidth + 6
    Columns("D:D").ColumnWidth = Columns("H:H").ColumnWidth + 6
    Columns("E:E").ColumnWidth = Columns("I:I").ColumnWidth + 6
    Columns("F:F").ColumnWidth = Columns("J:J").ColumnWidth + 6
    Range("A6", Range("E7").End(xlDown).Offset(0, -1)).Delete Shift:=xlToLeft
    Columns("G:J").ColumnWidth = 8.43

' Remove unnecessary cells
    Cells(TotalUnits + 7, 7) = "x"
    Range(Cells(TotalUnits + 7, 7), Cells(TotalUnits + 7, 7).SpecialCells(xlLastCell)).EntireRow.Delete
    Cells(TotalUnits + 7, 7) = "x"
    Range(Cells(TotalUnits + 7, 7), Cells(TotalUnits + 7, 7).SpecialCells(xlLastCell)).EntireColumn.Delete

' Borders
    With Range("A7", Range("A7").End(xlDown).End(xlToRight))
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeBottom).Weight = xlThick
    End With
    With Range("A6:F6")
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeBottom).Weight = xlThick
    End With
    For Counter1 = 1 To TotalMains - 1
        With Range(Cells(nTreat2.Value * Counter1 + 7, 1), Cells(nTreat2.Value * Counter1 + 7, 6)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
    Next Counter1
    For Counter1 = 1 To nBlock - 1
        With Range(Cells(TotalTreats * Counter1 + 7, 1), Cells(TotalTreats * Counter1 + 7, 6)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
    Next Counter1
    
' Layout sheet
    Worksheets("Design, layout").Activate
    Columns.ColumnWidth = 8.43
    Range("A3") = "x"
    Range("A3", Range("A3").SpecialCells(xlLastCell)).EntireRow.Delete
    Worksheets("Design, list").Activate
    Range("A3", Range("A3").SpecialCells(xlLastCell)).Copy
    Worksheets("Design, layout").Activate
    Range("A3").PasteSpecial xlPasteAll
    Range("A3", Range("A3").SpecialCells(xlLastCell)).Borders.LineStyle = xlNone
    Range("F7", Cells(TotalUnits + 6, 6)).FormulaR1C1 = "=IF(RC2<>R[-1]C2,RC3,"""")"
    For Counter1 = 1 To nBlock
        Cells(6, 2 * Counter1 + 8) = Counter1
        With Cells(6, 2 * Counter1 + 7)
            .FormulaR1C1 = "=R6C1&"" ""&RC[1]"
            .Copy
            .PasteSpecial xlPasteValues
        End With
        Cells(6, 2 * Counter1 + 8).ClearContents
        Cells(7, 2 * Counter1 + 7) = Range("C6")
        Cells(7, 2 * Counter1 + 8) = Range("E6")
        For Counter2 = 1 To TotalTreats
            Cells(Counter2 + 7, 2 * Counter1 + 8) = _
                Cells((Counter1 - 1) * TotalTreats + Counter2 + 6, 5)
            Cells(Counter2 + 7, 2 * Counter1 + 7) = _
                Cells((Counter1 - 1) * TotalTreats + Counter2 + 6, 6)
        Next Counter2
    Next Counter1
    Range("D7", Cells(TotalTreats + 6, 4)).Copy
    Range("H8").PasteSpecial xlPasteValues
    With Range("G8", Cells(TotalTreats + 7, 7))
        .FormulaR1C1 = "=IF(R[-1]C2<>R[-2]C2,R[-1]C2,"""")"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    Range("G7") = Range("B6")
    Range("H7") = Range("D6")
    Range("G6", Range("G7").End(xlToRight)).EntireColumn.AutoFit
    For Counter1 = 1 To 2 * (nBlock + 1)
        Range("A1").Offset(0, Counter1 - 1).Columns("A:A").ColumnWidth = _
            Range("G1").Offset(0, Counter1 - 1).Columns("A:A").ColumnWidth + 6
    Next Counter1
    Range("A6", Cells(TotalUnits + 6, 6)).ClearContents
    For Counter1 = 1 To 2 * (nBlock + 1)
        For Counter2 = 1 To TotalTreats + 2
            Cells(Counter2 + 5, Counter1) = Cells(Counter2 + 5, Counter1 + 6)
        Next Counter2
    Next Counter1
    Cells(TotalTreats + 8, 2 * nBlock + 3) = "x"
    Range(Cells(TotalTreats + 8, 2 * nBlock + 3), Cells(TotalTreats + 8, 2 * nBlock + 3).SpecialCells(xlLastCell)).EntireRow.Delete
    Cells(TotalTreats + 8, 2 * nBlock + 3) = "x"
    Range(Cells(TotalTreats + 8, 2 * nBlock + 3), Cells(TotalTreats + 8, 2 * nBlock + 3).SpecialCells(xlLastCell)).EntireColumn.Delete
    Range("A6", Cells(6, 2 * (nBlock + 1))).HorizontalAlignment = xlLeft
    Range("A6", Range("A7").End(xlToRight)).Font.Bold = True
    Range("A7", Range("B7").End(xlDown).End(xlToRight)).HorizontalAlignment = xlCenter
    With Range("A7", Range("B7").End(xlDown).End(xlToRight))
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlEdgeTop).Weight = xlThick
    End With
    With Range("A6", Cells(6, 2 * (nBlock + 1)))
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
    For Counter1 = 1 To nBlock
        With Range(Cells(6, 2 * Counter1), Cells(TotalTreats + 7, 2 * Counter1))
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
    Next Counter1
    For Counter1 = 1 To nTreat1.Value - 1
        With Range(Cells(nTreat2.Value * Counter1 + 7, 1), Cells(nTreat2.Value * Counter1 + 7, 2 * (nBlock + 1)))
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
    Next Counter1
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$7"
        .PrintTitleColumns = ""
        .CenterFooter = "Page &P of &N"
    End With
    Range("D1").Select
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    
' Terminate
    Worksheets("Design, list").Activate
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$6"
        .PrintTitleColumns = ""
        .CenterFooter = "Page &P of &N"
    End With
    Sheets("Design, list").Range("D1").Select
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    Application.ScreenUpdating = True
    Response = MsgBox("Now save this spreadsheet!", 0, "Edgar II")
    
    Else
        Application.ScreenUpdating = True
    End If

End Sub
Sub SuddenStop()
    Application.ScreenUpdating = True
    ActiveWindow.LargeScroll Down:=1
    ActiveWindow.LargeScroll Up:=1
    NoWorries = False
End Sub


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


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



============================================================
--- Sheet1.cls ---
============================================================
Attribute VB_Name = "Sheet1"
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


============================================================
--- Sheet3.cls ---
============================================================
Attribute VB_Name = "Sheet3"
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

