Protocol Macro - final

Sub Main()

End Sub

Sub CopyData()
    Dim col As Variant
    col = GetColAddress("Sheet0", "Username")

    If col = False Then
        MsgBox "Username not found"
    Else
        Sheets("Sheet0").Select
        Columns(col).Select
        Selection.Copy
        Sheets("Protocol").Select
        Columns(1).Select
        ActiveSheet.Paste
    End If

End Sub

Function GetColAddress(sheetName, target As String)
    Dim col As Range

    Set col = Sheets(sheetName).Rows(1).Find(What:=target)

    If col Is Nothing Then
        GetColAddress = False
    Else
        GetColAddress = col.Column
    End If
End Function

Sub InsertColumns()
    Sheets("Protocol").Select
    Range("B1").Select
    ActiveCell = "Course Points"
    Range("C1").Select
    ActiveCell = "Grade"
    Range("D1").Select
    ActiveCell = "Practical Points"
    Range("E1").Select
    ActiveCell = "Theoretical Points"

End Sub

Sub FormatHeader(lastRow As Integer)
    Range("A1:E" & lastRow).Select
    Selection.ColumnWidth = 30
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1:E1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 15
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
End Sub

Sub CoursePoints(lastRow, percentPractical, percentTheoretical As Integer)
    '=D2*80/100 + E2*20/100
    Dim isNotParticipate As Boolean

    For r = 2 To lastRow
        isNotParticipate = Range("D" & r) = "NO" And Range("E" & r) = "NO"
        If isNotParticipate Then
            Range("B" & r) = "Did not appear for the exam!"
        Else
            Range("B" & r) = _
            "=D" & r & "*" & percentPractical & "/100 + E" & r & "*" & percentTheoretical & "/100"
        End If
    Next
End Sub

Sub PracticalAndTheoreticalPoints(lastRow As Integer)
    '=VLOOKUP(A2,'Practical Points'!A:B,2,FALSE)
    For r = 2 To lastRow
        Range("D" & r) = _
        "=VLOOKUP(A" & r & ",'Practical Points'!A:B,2,FALSE)"
        Range("E" & r) = _
        "=VLOOKUP(A" & r & ",'Theoretical Points'!A:B,2,FALSE)"

        If Range("D" & r) = 0 And Range("E" & r) = 0 Then
        Range("D" & r) = "NO"
        Range("E" & r) = "NO"
        End If
    Next

End Sub

Sub Grade(lastRow, pointsFor5, pointsFor3 As Integer)
    '=IF(B2=100,6,IF(B2 <=70,3+2*(B2 -30)/(70-30),5+(B2 -70)/(95-70)))

    For r = 2 To lastRow
        If Range("B" & r) = "Did not appear for the exam!" Then
            Range("C" & r) = ""
        ElseIf Range("B" & r) = 100 Then
            Range("C" & r) = 6
        ElseIf Range("B" & r) <= pointsFor5 Then
            Range("C" & r) = "=3+2*(B" & r & " -" & pointsFor3 & ")/(" & pointsFor5 & "-" & pointsFor3 & ")"
            If Range("C" & r) < 2 Then
                Range("C" & r) = 2
            ElseIf Range("C" & r) > 6 Then
                Range("C" & r) = 6
            End If
        Else
            Range("C" & r) = "=5+(B" & r & "-" & pointsFor5 & ")/(95-" & pointsFor5 & ")"
            If Range("C" & r) > 6 Then
                Range("C" & r) = 6
            End If
        End If
    Next
End Sub