Extracting VBA from: 2FactorRCB.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 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("B10")
    Set nTreat2 = Range("B13")
    Set nBlock = Range("B16")
    Set Treat1Name = Range("C21", Cells(nTreat1.Value + 20, 3))
    Set Treat2Name = Range("E21", Cells(nTreat2.Value + 20, 5))
    TotalTreats = nTreat1.Value * nTreat2.Value
    TotalUnits = TotalTreats * nBlock.Value
    Range("B7").Select
    NoWorries = True
    If nTreat1 < 2 Then
        Range("B10").Select
        SuddenStop
        Response = MsgBox("Minimum 2 treatments", 0, "Edgar II")
    End If
    If NoWorries And nTreat2 < 2 Then
        Range("B13").Select
        SuddenStop
        Response = MsgBox("Minimum 2 treatments", 0, "Edgar II")
    End If
    If NoWorries And nBlock < 1 Then
        Range("B16").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(21 + nTreat1, 3), Cells(120, 3)).ClearContents
    If nTreat2 < 100 Then Range(Cells(21 + nTreat2, 5), Cells(120, 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
' Treatment 1
    Treat1Name.Copy
    Worksheets("Design, list").Range("A7").PasteSpecial Paste:=xlPasteValues
    Set TreatRange = Range("A7", Cells(nTreat1 + 6, 1))
    Counter1 = 0
    For Each C In TreatRange
        Counter1 = Counter1 + 1
        If C = "" Then C = Counter1
    Next C
    Set TreatRangeAll = Range("A7", Cells(TotalUnits + 6, 1))
    TreatRange.Copy
    TreatRangeAll.PasteSpecial xlPasteValues
' Treatment 2
    Treat2Name.Copy
    Worksheets("Design, list").Range("B7").PasteSpecial Paste:=xlPasteValues
    Set TreatRange = Range("B7", Cells(nTreat2 + 6, 2))
    Counter1 = 0
    For Each C In TreatRange
        Counter1 = Counter1 + 1
        If C = "" Then C = Counter1
    Next C
    Set TreatRangeAll = Range("B7", Cells(TotalTreats + 6, 2))
    TreatRange.Copy
    TreatRangeAll.PasteSpecial xlPasteValues
    TreatRangeAll.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlNo, _
        MatchCase:=False, Orientation:=xlTopToBottom
    Set TreatRange = TreatRangeAll
    Set TreatRangeAll = Range("B7", Cells(TotalUnits + 6, 2))
    TreatRange.Copy
    TreatRangeAll.PasteSpecial xlPasteValues
' Design before randomisation
    Range("C7") = TotalTreats
    Range("J7").FormulaR1C1 = "=R[-1]C+1"
    Range("G7").FormulaR1C1 = "=RC1"
    Range("H7").FormulaR1C1 = "=RC2"
    Range("E7").FormulaR1C1 = "=int((RC10-1)/R7C3)+1"
    Range("F7").FormulaR1C1 = "=mod(RC10-1,R7C3)+1"
    Range("I7").Formula = "=RC5+rand()"
    Range("E7:J7").Copy
    With Range("E7", Cells(TotalUnits + 6, 10))
        .PasteSpecial xlPasteFormulas
        .Copy
        .PasteSpecial xlPasteValues
    End With

' Randomise order of treatments
    Range("G7", Range("I7").End(xlDown)).Sort Key1:=Range("I7"), Order1:=xlAscending, Header:=xlNo, _
        MatchCase:=False, Orientation:=xlTopToBottom
    Range("I7", Range("J7").SpecialCells(xlLastCell)).ClearContents

' Tidy up Design columns
    Range("D6") = "Unit"
    Range("E6").Formula = "=IF('Describe experiment'!B15="""",""Block"",proper('Describe experiment'!B15))"
    Range("F6").Formula = "=IF('Describe experiment'!B18="""",""Plot"",proper('Describe experiment'!B18))"
    Range("G6").Formula = "=IF('Describe experiment'!B9="""",""Treatment1"",proper('Describe experiment'!B9))"
    Range("H6").Formula = "=IF('Describe experiment'!B12="""",""Treatment2"",proper('Describe experiment'!B12))"
    Range("D7") = 1
    With Range("D8", Cells(TotalUnits + 6, 4))
        .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("D:H")
        .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
    End With
    Columns("A:A").ColumnWidth = Columns("D:D").ColumnWidth + 6
    Columns("B:B").ColumnWidth = Columns("E:E").ColumnWidth + 6
    Columns("C:C").ColumnWidth = Columns("F:F").ColumnWidth + 6
    Columns("D:D").ColumnWidth = Columns("G:G").ColumnWidth + 6
    Columns("E:E").ColumnWidth = Columns("H:H").ColumnWidth + 6
    Range("A6", Range("D7").End(xlDown).Offset(0, -1)).Delete Shift:=xlToLeft
    Columns("F:I").ColumnWidth = 8.43

' Remove unnecessary cells
    Cells(TotalUnits + 7, 6) = "x"
    Range(Cells(TotalUnits + 7, 6), Cells(TotalUnits + 7, 6).SpecialCells(xlLastCell)).EntireRow.Delete
    Cells(TotalUnits + 7, 6) = "x"
    Range(Cells(TotalUnits + 7, 6), Cells(TotalUnits + 7, 6).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 = xlMedium
    End With
    With Range("A6:E6")
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    For Counter1 = 1 To nBlock - 1
        With Range(Cells(TotalTreats * Counter1 + 7, 1), Cells(TotalTreats * Counter1 + 7, 5)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        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
    For Counter1 = 1 To nBlock
        Cells(7, Counter1 + 5) = Counter1
        For Counter2 = 1 To TotalTreats
            Cells(Counter2 + 7, Counter1 + 5) = _
                Cells((Counter1 - 1) * TotalTreats + Counter2 + 6, 3) & Chr(10) & _
                Cells((Counter1 - 1) * TotalTreats + Counter2 + 6, 4)
        Next Counter2
    Next Counter1
    Range("B6", Cells(TotalTreats + 6, 2)).Copy
    Range("E7").PasteSpecial xlPasteValues
    Range("E6").FormulaR1C1 = Range("C6") & Chr(10) & Range("D6")
    Range("E6", Range("D7").End(xlToRight)).Font.Bold = True
    Range(Range("E7").End(xlDown).Offset(1, 0), Range("E7").End(xlDown).Offset(2, 0)).Font.Bold = True
    Cells(TotalTreats + 8, 5) = Range("C6")
    Cells(TotalTreats + 9, 5) = Range("D6")
    Range("E6", Range("D7").End(xlToRight)).Font.Bold = True
    Range("C7", Cells(TotalTreats + 6, 3)).Copy
    Range(Range("F7").End(xlDown).Offset(1, 0), Range("F7").End(xlDown).Offset(TotalTreats, 0)) _
        .PasteSpecial xlPasteValues
    Range("D7", Cells(TotalTreats + 6, 4)).Copy
    Range(Range("F7").End(xlDown).Offset(1, 0), Range("F7").End(xlDown).Offset(TotalTreats, 0)) _
        .PasteSpecial xlPasteValues
    Range("E1", "F1").EntireColumn.AutoFit
    For Counter1 = 1 To nBlock - 1
        Range("A1").Offset(0, Counter1 + 5).Columns("A:A").ColumnWidth = _
            Columns("F:F").ColumnWidth
    Next Counter1
    For Counter1 = 1 To nBlock + 1
        Range("A1").Offset(0, Counter1 - 1).Columns("A:A").ColumnWidth = _
            Range("E1").Offset(0, Counter1 - 1).Columns("A:A").ColumnWidth + 6
    Next Counter1
    Range("F6") = Range("A6")
    
    Range("D6", Range("D6").End(xlDown).End(xlToLeft)).ClearContents
    
    Range("A6") = Range("E6")
    Range("B6") = Range("F6")
    For Counter1 = 1 To nBlock + 1
        For Counter2 = 1 To TotalTreats + 1
            Cells(Counter2 + 6, Counter1) = Cells(Counter2 + 6, Counter1 + 4)
        Next Counter2
    Next Counter1
    Range("E6", Range("E6").End(xlToRight)).ClearContents
    Counter2 = Application.WorksheetFunction.Max(nBlock, 4)
    For Counter1 = 1 To Counter2
        Cells(5, nBlock + 2).Offset(0, Counter1 - 1).Columns("A:A").ColumnWidth = 8.43
    Next Counter1
    Range(Cells(5, nBlock + 2), Cells(5, nBlock + 2).SpecialCells(xlLastCell)).Delete
    Range(Cells(TotalTreats + 8, 1), Cells(TotalTreats + 8, 1).SpecialCells(xlLastCell)).Delete
    Range("A7", Range("A7").End(xlToRight)).Font.Bold = True
    Range("A6:B6").HorizontalAlignment = xlLeft
    Range("A7", Range("A7").End(xlDown).End(xlToRight)).HorizontalAlignment = xlCenter
    With Range("B8", Range("B8").End(xlDown).End(xlToRight))
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    With Range("A7", Range("A7").End(xlDown))
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
    End With
    With Range("A7", Range("A7").End(xlToRight))
        .Font.Bold = True
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
    End With
    With Range("A7").Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    Range("A8", Range("A8").End(xlDown)).VerticalAlignment = xlVAlignCenter
    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

