'v.1.1.20
'Code is totally rewriten.
'Increased speed of calculation.

'-------------------------------------------------SOME HELPFUL FUNCTIONS--------------------------------------------
Function Inc(ByRef val As Variant, Optional ByVal add As Variant = 1) As Variant
    val = val + add
    Inc = val
End Function

Sub DelButtons(ByRef WS As Worksheet)
    Dim btn As Shape
    For Each btn In WS.Shapes
        If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
    Next
End Sub
'-------------------------------------------------------------------------------------------------------------------

'-------------------------------------------------MY OWN TYPES------------------------------------------------------
Public Type Manager
    NickName As String          'manager's name which is used to mark him in a table
    RealName As String          'name to display in statistics
    City As String              'city where manager works
End Type

Private Type Exchange
    ExchangeType As String      'обмен | расход | доход
    Day As String               'the day when exchange took place
    ProjectName As String       '
    Description As String       '
    Amount(17) As Double        'the amount of each currency (1-index)
    ExchangeRate As Double      'the number from table
    Manager As Long             'the person who made exchange
    BuyOrSell As String         'Buy cryptocurrency or Sell cryptocurrency
    Pair As Long                'the number of almost equal exchange (or -1 if none)
    Profit As Double            'profit of exchange
    CurrencyNumber As Long      'profit currency number
    ProfitPercentage As Double  '
    DealNumber As Long          'the number of deal which's part this exchange is
    Errors As String            '
End Type
'-------------------------------------------------------------------------------------------------------------------

'-------------------------------------------------GLOBAL VARIABLES--------------------------------------------------
Dim numberOfManagers            '
Dim numberOfExchanges As Long   'number of good exchanges from the month
Dim managers(4) As Manager      '
Dim currencyNames(16)           'currency names
Dim monthToCalculate As String  'the month for which script calculates bonuses
Dim exchanges() As Exchange     'exchanges made in MonthToCalculate (1-index)
Dim exchangesCopy() As Exchange '
'-------------------------------------------------------------------------------------------------------------------


Sub CalculateBonusMacros()
    Application.ScreenUpdating = False
    Dim WS As Worksheet
    If Init(WS, True, "Bonus") Then
        Call CalculateProfit(WS, "Bonus")
    End If
    Application.ScreenUpdating = True
End Sub

Sub CalculateDailyRevenueMacros()
    Application.ScreenUpdating = False
    Dim WS As Worksheet
    If Init(WS, True, "Daily revenue") Then
        Call CalculateProfit(WS, "Daily revenue")
    End If
    Application.ScreenUpdating = True
End Sub

Sub InitManager(NickName As String, RealName As String, City As String)
    Inc numberOfManagers
    With Manager(numberOfManagers)
        .NickName = NickName
        .RealName = RealName
        .City = City
    End With
End Sub

Function TableHasBadInformation() As Boolean
    Dim i, j, k, cnt, cntNegative, cntPositive, cntErrors As Long
    Dim cntErrors As Long

    If IsEmpty(Cells(1, 18).Value) Then
        MsgBox "Введите месяц"
        TableHasBadInformation = True
        Exit Function
    End If

    cntErrors = 0
    For i = 3 To Rows.Count
        If IsEmpty(Cells(i, 1).Value) Then
            Exit For
        End If
        If GoodDay(Cells(i, 2).Value) = False Then Next i
        If Cells(i, 1).Value = "обмен" And Cells(i, 4).Value <> "Неучтенный доход" And Cells(i, 4).Value <> "Неучтенный расход" And Cells(i, 1).Interior.Color <> vbRed Then
            cnt = 0
            cntPositive = 0
            cntNegative = 0
            For k = 5 To 17
                If k <> 6 And IsEmpty(Cells(i, k).Value) = False Then
                    If Cells(i, k).Value <> 0 Then cnt = cnt + 1
                    If Cells(i, k).Value > 0 Then cntPositive = cntPositive + 1
                    If Cells(i, k).Value < 0 Then cntNegative = cntNegative + 1
                End If
            Next k
            If cnt >= 2 And cntPositive > 0 And cntNegative > 0 And GoodDay(ActiveSheet, Cells(i, 2).Value) Then
                For k = 1 To 18
                    If IsEmpty(Cells(i, k).Value) = False And IsNumeric(Cells(i, k).Value) = False And cntErrors < 5 And k > 4 And k < 18 Then
                        Inc cntErrors
                        MsgBox "Cell in line " & i & " column " & k & "(" & Cells(1, k).Value & ") contains something strange, expected number"
                    End If
                Next k
            End If
        End If
    Next i

    If cntErrors > 0 Then
        MsgBox "script can't work with errors in the table"
        TableHasBadInformation = True
        Exit Function
    End If

    TableHasBadInformation = False
End Function

Function Init(ByRef WS As Worksheet, clear As Boolean, ByVal buttonName As String) As Boolean
    Dim f As Boolean
    Dim newSheetName, s As String
    Dim i, j, k, cnt, cntNegative, cntPositive, cntErrors As Long

    If TableHasBadImformation Then
        Init = False
        Exit Function
    End If

    Call InitManager("л", "Л", "Moscow")
    Call InitManager("ю", "Ю", "Moscow")
    Call InitManager("п", "П", "Moscow")

    k = 1
    For j = 5 To 17
        If j = 6 Then j = 7
        currencyNames(k) = Cells(1, j).Value
        Inc k
    Next j


    newSheetName = buttonName & " - " & Cells(1, 18).Value
    'If There is already sheet with such name, then don't create a new sheet ...
    f = False
    For Each it In Sheets
        If it.Name = newSheetName Then
            Set WS = it
            f = True
            If clear Then WS.Cells.clear
        End If
    Next it
    '... but if there not such sheet, then create a new one
    If f = False Then
        s = ActiveSheet.Name
        Set WS = Sheets.add
        WS.Name = newSheetName
        Worksheets(s).Activate
    End If

    WS.Visible = True

    Range("A1:R1").Copy WS.Range("A1:R1")
    Range("E2:R2").Copy WS.Range("E2:R2")

    Call DelButtons(WS)

    monthToCalculate = Cells(1, 18).Value

    'Copy exchanges from the month
    j = 1
    Do While IsEmpty(Cells(j, 1).Value) = False
        If GoodDay(Cells(i, 2).Value) Then Inc j
    Loop
    ReDim exchanges(j)

    numberOfExchanges = 0
    For i = 3 To Rows.Count
        If IsEmpty(Cells(i, 1).Value) Then
            Exit For
        End If
        If GoodDay(Cells(i, 2).Value) = False Then Next i
        If Cells(i, 1).Value = "обмен" And Cells(i, 4).Value <> "Неучтенный доход" And Cells(i, 4).Value <> "Неучтенный расход" And Cells(i, 1).Interior.Color <> vbRed Then
            cnt = 0
            cntPositive = 0
            cntNegative = 0
            For k = 5 To 17
                If k <> 6 And IsEmpty(Cells(i, k).Value) = False Then
                    With Cells(i, k)
                        If .Value <> 0 Then Inc cnt
                        If .Value > 0 Then Inc cntPositive
                        If .Value < 0 Then Inc cntNegative
                    End With
                End If
            Next k
            If cnt >= 2 And cntPositive > 0 And cntNegative > 0 Then
                Inc numberOfExchanges
                With exchanges(numberOfExchanges)
                    .ExchangeType = WS.Cells(i, 1).Value
                    .Day = WS.Cells(i, 2).Value
                    .ProjectName = WS.Cells(i, 3).Value
                    .Description = WS.Cells(i, 4).Value
                    .ExchangeRate = IIf(IsEmpty(WS.Cells(i, 6).Vlaue), -1, WS.Cells(i, 6).Vlaue)

                    k = 1
                    For j = 5 To 17
                        If j = 6 Then j = 7
                        .Amount(k) = IIf(IsEmpty(WS.Cells(i, j).Value), 0, WS.Cells(i, j).Value)
                        Inc k
                    Next j

                    .Manager = 0
                    If IsEmpty(WS.Cells(i, 18).Value) = False Then
                        For j = 1 To numberOfManagers
                            If WS.Cells(i, 18).Value = Manager(j).NickName Then
                                .Manager = j
                            End If
                        Next j
                    End If

                    .BuyOrSell = ""
                    .Pair = -1
                    .Profit = 0#
                    .CurrencyNumber = 0
                    .ProfitPercentage = 0#
                    .DealNumber = 0
                    .Errors = ""
                End With
            End If
        End If
    Next i
    WS.Cells(1, 1).EntireColumn.AutoFit
    WS.Cells(1, 2).EntireColumn.AutoFit
    WS.Cells(1, 3).EntireColumn.AutoFit
    WS.Cells(1, 4).EntireColumn.AutoFit
    WS.Cells(1, 5).EntireColumn.AutoFit
    'MsgBox "Init"
End Function


'Function that controls calls of auxiliary functions
'The result of evaluation is calculated profits and perfect look of the table
Private Sub CalculateProfit(ByRef WS As Worksheet, ByVal buttonName As String)

End Sub