Workshop - Solution

Sub Main()
' main procedure - all actionsover my table
 Copy_Data
 Insert_Columns
 Formatting_Protocol
 Fill_Practical_And_Theoretical_Points
 CoursePoints 80, 20
 Grade 70, 30

End Sub

Sub Copy_Data()

    ' 1. Create new sheet
    ' 2. Copy username column

    Dim Col As Variant
    Col = GetColumnsAddress("Data", "Username")

    If Col = False Then
        MsgBox "Username not found"
    Else
        'copy column
        Sheets("Data").Select
        Columns(Col).Select
        Selection.Copy

        ' create new sheet
        Sheets.Add(Before:=Sheets("Data")).Name = "Protocol"

        ' paste new sheet
        Sheets("Protocol").Select
        Columns(1).Select
        ActiveSheet.Paste

    End If

End Sub

Function GetColumnsAddress(SheetName, TargetColumnName As String)
    Set Col = Sheets(SheetName).Rows(1).Find(What:=TargetColumnName) 'Set -> return whole object

    'maybe nothing
    If Col Is Nothing Then
        GetColumnsAddress = False
    Else
        GetColumnsAddress = Col.Column
    End If
End Function

Sub Insert_Columns()

Sheets("Protocol").Select
Range("B1") = "Common Points"
Range("C1") = "Grade"
Range("D1") = "Practical Points"
Range("E1") = "Theoretical Points"

End Sub

Sub Formatting_Protocol()
    Sheets("Protocol").Select
    Range("A1").Select
    Selection.End(xlToRight).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-2690
    Application.CutCopyMode = False
    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
    Selection.ColumnWidth = 30
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
End Sub

Sub Fill_Practical_And_Theoretical_Points()
    ' =VLOOKUP(A2, 'Practical Points'!A:B,2,FALSE)
    Sheets("Protocol").Select

    'Variant 1
    'Range("D2").Formula = "=VLOOKUP(A2, 'Practical Points'!A:B,2,FALSE)"
    'Range("D2").AutoFill Range("D2:D2711")

    'Range("E2").Formula = "=VLOOKUP(A2, 'Theoretical Points'!A:B,2,FALSE)"
    'Range("E2").AutoFill Range("E2:E2711")

    'Variant 2
    Dim LastRow, Row As Integer
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For Row = 2 To LastRow
        Range("D" & Row) = "=VLOOKUP(A" & Row & ", 'Practical Points'!A:B,2,FALSE)"
        Range("E" & Row) = "=VLOOKUP(A" & Row & ", 'Theoretical Points'!A:B,2,FALSE)"

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

End Sub

Sub CoursePoints(percentPractical, percentTheoretical As Integer)
'=P*PP/ 100 + T*PT / 100
'=D2*80/ 100 + E2*20 / 100
'P – Number of points from the Practical exam
'T – Number of points from the Theoretical exam
'PP – Percentage from the Practical exam
'PT – Percentage from the Theoretical exam

Sheets("Protocol").Select
    Dim LastRow, Row As Integer
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Dim IsNotParticipate As Boolean
    IsNotParticipate = False

    For Row = 2 To LastRow
        IsNotParticipate = Range("D" & Row) = "NO" And Range("E" & Row) = "NO"

        If IsNotParticipate Then
            Range("B" & Row) = "Did not participate in the exam"
        Else
            Range("B" & Row) = _
        "=D" & Row & "*" & percentPractical & " / 100 + E" & Row & "*" & percentTheoretical & " / 100"
        End If
    Next
End Sub

Sub Grade(pointsFor5, pointsFor3 As Integer)

Sheets("Protocol").Select
'=IF(C=100,6,IF(C <=A,3+2*( C - B)/(A - B),5+( C - A)/(95 - A)))
'A – Minimum number of course points for a grade of 5
'B – Minimum number of course points for a grade of 3
'C – Number of course points (taken from the corresponding cell after calculation)

 Dim LastRow, Row As Integer
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

 For Row = 2 To LastRow
    If Range("B" & Row) = "Did not participate in the exam" Then
        Range("C" & Row) = ""
    ElseIf Range("B" & Row) = 100 Then
         Range("C" & Row) = 6
    ElseIf Range("B" & Row) <= pointsFor5 Then
        Range("C" & Row) = "=3 + 2 * (B" & Row & " - " & pointsFor3 & ")/(" & pointsFor5 & " - " & pointsFor3 & ")"
        If Range("C" & Row) < 2 Then
            Range("C" & Row) = 2
        End If
    Else
        Range("C" & Row) = "= 5 + (B" & Row & " - " & pointsFor5 & ")/ (95 - " & pointsFor5 & ")"
          If Range("C" & Row) > 6 Then
            Range("C" & Row) = 6
        End If
    End If
 Next

End Sub