CountryIterations.vba

'Runs a country iteration and does many calculations
Sub CountryIterations()
    Dim iteration, period As Integer
        
    iteration = Range("countryIterations")
    
    If Not (IsNumeric(iteration)) Or iteration < 10 Then
        MsgBox ("You must set the iterations above 10, check address " + Range("countryIterations").AddressLocal)
        Exit Sub
    End If
    
    period = 40
    
    Application.Calculation = xlManual
    
    Dim rowAdrs As String
    Dim pricesMat As Variant
    
    ReDim rowPrices(period) As Double
    ReDim resultMat(iteration - 1, period) As Double
    
    pricesMat = generatePricesMatrix()
    
    Dim r1, c1, rSum, cSum, i, j As Integer
    ' Get pos start for the prices
    r1 = Range("resultStochasticPosStart").row
    c1 = Range("resultStochasticPosStart").Column
    ' Get the pos for the results
    rSum = Range("countryInterationPosStart").row
    cSum = Range("countryInterationPosStart").Column

    rowAdrs = Cells(r1, c1).Address + ":" + Cells(r1, c1 + period).Address
    ' To obtain correctly the results
    Application.Calculation = xlSemiautomatic
    
    Dim debugAddress As String
    
    ' paste prices
    For i = 0 To iteration - 1
        For j = 0 To period
            rowPrices(j) = pricesMat(i, j)
        Next j
        'Debug.Print rowAdrs, rowPrices(0), rowPrices(1), rowPrices(3)
        
        Sheets("Result").Range(rowAdrs) = rowPrices
        
        
        ' Get results
        For j = 0 To period
            If IsNumeric(Sheets("Result").Cells(rSum, cSum + j).Value) Then
                resultMat(i, j) = Sheets("Result").Cells(rSum, cSum + j).Value
            Else
                resultMat(i, j) = 0
            End If
        Next j
        
    Next i
    Application.Calculation = xlManual
    'Application.Calculation = xlManual
    ' Order the results
    'Debug.Print UBound(resultMat, 1), UBound(resultMat, 2)
    
    Debug.Print resultMat(0, 0), resultMat(0, 1), resultMat(0, 2), resultMat(0, 3)
    Debug.Print resultMat(1, 0), resultMat(1, 1), resultMat(1, 2), resultMat(1, 3)
    
    ' Clear contents
    Range(Range("countryIterFreq"), Range("countryIterFreqEnd")).ClearContents
    ' Clear contents
    Range(Range("countryIterPriceRanges"), Range("countryIterPriceRangesEnd")).ClearContents
    
    ReDim tempMat(iteration - 1), pricesVector(period) As Double
    
    ReDim percentMat(20, 54) As Double
    
    Dim resRanges As Variant
        
    ' Calculate frequecy percentil etc
    For j = 0 To period
        For i = 0 To iteration - 1
            tempMat(i) = resultMat(i, j)
        Next i
        
        Call QuickSort(tempMat, 0, UBound(tempMat))
        
        ' debug address
        'debugAddress = Cells(j + 1, 1).Address + ":" + Cells(j + 1, period).Address
        'Sheets("debug2").Range(debugAddress) = tempMat
        
        'Debug.Print "Min and Max"
        'Debug.Print getMinValue(tempMat), getMaxValue(tempMat)
        resRanges = CreateRanges(tempMat, j)
                
        Debug.Print resRanges(0), resRanges(39)
        Call CreateFreqs(tempMat, resRanges, j, percentMat)
    Next j
    
    With Sheets("Result")
        .Range(Range("percentMatStart"), Range("percentMatEnd")).ClearContents
        .Range(Range("percentMatStart"), Range("percentMatEnd")) = percentMat
    End With
    
    Application.Calculation = xlSemiautomatic
End Sub


' Creates the frequencies
Sub CreateFreqs(arr, arrRanges, col, percentMat)
    Dim tmp, c1, r1, i2, i As Integer
    tmp = 0
    r1 = 0
    i2 = 0
    i = 0
    
    ReDim arr2(UBound(arrRanges)) As Double
    
    r1 = Range("countryIterFreq").row
    c1 = Range("countryIterFreq").Column
    
    '
    'Debug.Print arr(0), arr(1), arr(2), arr(3), arr(4), arr(5), arr(6), arr(7)
    'Debug.Print arrRanges(0), arrRanges(1), arrRanges(2), arrRanges(3), arrRanges(4), arrRanges(5)
    Dim oldVal As Double
    
    tmp = 0
    oldVal = arrRanges(0)
    For i = 0 To UBound(arrRanges)
        Do While i2 <= UBound(arr) And arr(i2) < arrRanges(i)
            i2 = i2 + 1
            tmp = tmp + 1
        Loop
        
        Sheets("Result").Cells(r1 + i, c1 + col) = tmp
        arr2(i) = tmp
        tmp = 0
    Next i
    
    Call HistogramPercentages2(col, arr2, arrRanges, percentMat)
End Sub


' Creates the ranges and returns a matrix with it
Function CreateRanges(arr, col) As Variant
    Dim r1, c1 As Integer
    Dim res, minVal, maxVal As Double
    
    
    r1 = Range("countryIterPriceRanges").row
    c1 = Range("countryIterPriceRanges").Column
    
    ReDim resRanges(39) As Double
    minVal = getMinValue(arr)
    maxVal = getMaxValue(arr)
    
    res = (maxVal - minVal) / 40
    
    For i = 0 To 39
        If i = 39 Then
            Sheets("Result").Cells(r1 + i, c1 + col) = maxVal
            resRanges(i) = maxVal
        Else
            Sheets("Result").Cells(r1 + i, c1 + col) = minVal + res * i
            resRanges(i) = minVal + res * i
        End If
    Next i
    
    CreateRanges = resRanges
End Function


' Sorts a matrix by mat avg
Sub SortByMatAverage(ByRef mat As Variant)
    Dim rows, cols, i As Long
   
    rows = UBound(mat, 1)
    cols = UBound(mat, 2)
   
    For i = 0 To rows
        mat(i, cols) = calculateMatRowAvg(mat, i, cols - 1)
    Next i
   
    Call QuickSortMatrix(mat, cols, 0, cols)
End Sub


' Generates
Function generatePricesMatrix() As Variant
    Dim iteration, period As Integer
    Dim err, rndVal, maxPrice, minPrice, stdDev, stConstant, autoRegFactor As Double
    
    iteration = Range("countryIterations")
    period = 40
    
    ReDim FixedError(iteration - 1) As Double
    
    col = Range("H7").Column
    ReDim BigMat(iteration - 1, period)
    ReDim vals(period - 1) As Double
    
    maxPrice = Range("maxPrice")
    minPrice = Range("minPrice")
    stdDev = Range("priceStdDev") ' M85
    stConstant = Range("stockConstant") ' M83
    autoRegFactor = Range("autoregresionFactor") ' M84
    
    Debug.Print maxPrice, minPrice, stdDev, stConstant, autoRegFactor
    
    ' store prices
    For j = 0 To period - 1
        For i = 0 To iteration - 1
            '=SI(H7=1,$M$89,MAX($M$87,MIN($M$86,EXP($M$83+$M$84*LN(G95)+DISTR.NORM.INV(ALEATORIO(),0,1)*$M$85))))
            If Sheets("Prices").Cells(7, col + j).Value = 1 Then
                tot = Range("initialPrice").Value
            Else
                ' EXP($M$83+$M$84*LN(G95)+ DISTR.NORM.INV(RANDOM(),0,1)*$M$85)
                If Sheets("Prices").CheckBoxes("checkBoxRepeatError").Value = 1 Then
                    If FixedError(i) = 0 Then
                        FixedError(i) = WorksheetFunction.NormInv(Rnd, 0, 1) * stdDev
                    End If
                   
                    err = FixedError(i)
                Else
                    rndVal = Rnd
                    'Application.Calculation = xlSemiautomatic
                    err = WorksheetFunction.NormInv(rndVal, 0, 1) * stdDev
                End If
                
                
                tot = Exp(stConstant + autoRegFactor * Log(vals(j - 1)) + err)
 
                If useMinMax Then
                    ' compare with max price and get the MIN
                    tot = getMin(tot, maxPrice)
                    ' compare with min price and get the MAX
                    tot = getMax(tot, minPrice)
                End If
            End If
           
            BigMat(i, j) = Round(tot, 2)
            
        Next i
        vals(j) = BigMat(0, j)
        
        
    Next j
    
    generatePricesMatrix = BigMat
End Function

Sub testPGenerate()
    Dim arr As Variant
    
    arr = generatePricesMatrix
    
    For i = 0 To 20
        Debug.Print arr(i, 0), arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4)
    Next i
End Sub


' Finds the value less than
Function findPosInMat(col, MatPrice() As Double, val As Double) As Integer
    For i = 0 To 39
        If val > MatPrice(i, col) Then
            findPosInMat = i
        Else
            i = 39
        End If
    Next i
End Function


Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub

Sub UpdateResultCountries()

    Application.Calculation = xlManual
    
    countryTabColor = 65535
    Dim sName As String
    Dim col As Integer
    
    ' Clear the previous regime imports
    Sheets("Multi Scenario").Range("E12:AH49").ClearContents
    col = Range("E1").Column
    
    For Each sheet In Sheets
        If sheet.Tab.Color = countryTabColor Then
            Call LinkCountryResultRegimeImport(sheet.Name, col)
            col = col + 1
        End If
    Next sheet
    Application.Calculation = xlSemiautomatic
    
    Call UpdateMultiScenarioLinks
End Sub



Sub LinkCountryResultRegimeImport(sheetName As String, col As Integer)
    Dim row As Integer
    Dim rangeSrc As String
    
    row = SearchOutputDataStart(sheetName)
    
    If row > 0 Then
    
        'with direct Links
        For i = 0 To 37
            Sheets("Result").Cells(12 + i, col).Formula = "='" & sheetName & "'!C" & (row + i)
        Next i
    End If
    
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''
' module to create references in MultiScenario'
'''''''''''''''''''''''''''''''''''''''''''''''

Sub UpdateResultScenarioLinks()
    
    Application.Calculation = xlManual
    
    govRevTxt = "Government revenues Positions"
    resTxt = "Results Positions"
    col = 5
    
    Sheets("Multi Scenario").Range("E72:AH115").ClearContents
    
    For Each sh In Sheets
        If sh.Tab.Color Then
        
            rowGovRev = FindRowInSheet(sh, 4, govRevTxt)
            If rowGovRev > 0 Then
                Debug.Print "Copy col: " & col & ", page: " & sh.Name
                Call CopyGovRevenuesPositions(sh, col, rowGovRev + 2)
                Call CopyGovRevenueNames(sh, col, rowGovRev + 2)
            End If
            
            rowGovRes = FindRowInSheet(sh, 4, resTxt)
            If rowGovRes > 0 Then
                Call CopyResultsPositions(sh, col, rowGovRes + 2)
                Call CopyResultsNames(sh, col, rowGovRes + 2)
            End If
            
            col = col + 1
        End If
    Next sh
    
    Application.Calculation = xlSemiautomatic
End Sub

'Get Max Value in an array
Function getMaxValue(arr As Variant) As Double
    Dim L As Long
    getMaxValue = arr(0)
    L = UBound(arr)
   
    For i = 0 To L
        If arr(i) > getMaxValue Then getMaxValue = arr(i)
    Next i
End Function
 
'Get Min Value in an array
Function getMinValue(arr As Variant) As Double
    Dim L As Long
    getMinValue = arr(0)
    L = UBound(arr)
   
    For i = 0 To L
        If arr(i) < getMinValue Then getMinValue = arr(i)
    Next i
End Function
 
 
Function getMin(a, b) As Long
    If a < b Then
        getMin = a
    Else
        getMin = b
    End If
End Function
 
 
Function getMax(a, b) As Long
    If a > b Then
        getMax = a
    Else
        getMax = b
    End If
End Function

Sub testQuickSort()
    Dim arr(99) As Double
    
    For i = 0 To UBound(arr)
        arr(i) = Rnd * 100
    Next i
    
    Call QuickSort(arr, 0, UBound(arr))
    
    For i = 0 To UBound(arr)
        Debug.Print arr(i)
    Next i
End Sub

Sub testGetMinMax()
    Dim arr(9) As Double
    
    For i = 0 To UBound(arr)
        arr(i) = Rnd * 10
    Next i
    
    Debug.Print getMinValue(arr), getMaxValue(arr)
    
    For i = 0 To UBound(arr)
        Debug.Print arr(i)
    Next i
End Sub


' Macros to update the list
Sub UpdateResultImportCountries()

    Application.Calculation = xlManual
    
    countryTabColor = 65535
    Dim sName As String
    Dim col As Integer
    
    ' Clear the contents to update
    Range(Range("ResultCountriesStart"), Range("ResultCountriesEnd")).ClearContents
    col = Range("ResultCountriesStart").Column
    
    For Each sheet In Sheets
        If sheet.Tab.Color = countryTabColor Then
            Debug.Print "Result import for " & sheet.Name
            Call LinkCountryResult(sheet.Name, col)
            col = col + 1
        End If
    Next sheet
    Application.Calculation = xlSemiautomatic
    
    Call UpdateResultLinks
End Sub


' Links the result country data
Sub LinkCountryResult(sheetName As String, col As Integer)
    Dim row, rowOut As Integer
    Dim rangeSrc As String
    
    row = SearchOutputDataStart(sheetName)
    rowOut = Range("ResultCountriesStart").row
    
    If row > 0 Then
        'with direct Links
        For i = 0 To 37
            Sheets("Result").Cells(rowOut + i, col).Formula = "='" & sheetName & "'!C" & (row + i)
        Next i
        
        Sheets("Result").Cells(rowOut + 38, col) = sheetName
    End If
End Sub

Sub UpdateResultLinks()
    Application.Calculation = xlManual
    
    govRevTxt = "Government revenues Positions"
    resTxt = "Results Positions"
    col = Range("ResultCopyDataStart").Column
    
    Sheets("Result").Range(Range("ResultCopyDataStart"), Range("ResultCopyDataEnd")).ClearContents
    
    For Each sh In Sheets
        If sh.Tab.Color Then
            rowGovRev = FindRowInSheet(sh, 4, govRevTxt)
            If rowGovRev > 0 Then
                Debug.Print "Copy col: " & col & ", page: " & sh.Name
                Call CopyGovRevenuesPositions2(sh, col, rowGovRev + 2)
                Call CopyGovRevenueNames2(sh, col, rowGovRev + 2)
            End If
            
            rowGovRes = FindRowInSheet(sh, 4, resTxt)
            If rowGovRes > 0 Then
                Call CopyResultsPositions2(sh, col, rowGovRes + 2)
                Call CopyResultsNames2(sh, col, rowGovRes + 2)
            End If
            
            col = col + 1
        End If
    Next sh
    
    Application.Calculation = xlSemiautomatic
End Sub


' Copy Gov Revenues Positions
' Receives sh Sheet, col Integer, row Integer
Sub CopyGovRevenuesPositions2(sh, col, row)
    colPos = 3
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(72 + i, col).Value = sh.Cells(row + i, 3).Value
        End If
    Next i
End Sub


' Copy Gov Revenues Positions
' Receives sh Sheet, col Integer, row Integer
Sub CopyGovRevenuesPositionsResult2(sh, col, row)
    colPos = 3
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(72 + i, col).Value = sh.Cells(row + i, 3).Value
        End If
    Next i
End Sub

' Copy Gov Revenues Names
Sub CopyGovRevenueNames2(sh, col, row)
    colPos = 4
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(85 + i, col) = sh.Cells(row + i, colPos).Text
        End If
    Next i
End Sub

' Copy Gov Revenues Names
Sub CopyGovRevenueNamesResult2(sh, col, row)
    colPos = 4
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(85 + i, col) = sh.Cells(row + i, colPos).Text
        End If
    Next i
End Sub

' Copy ResutlsPostions in Multi Scenario

Sub CopyResultsPositions2(sh, col, row)
    colPos = 3
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(98 + i, col).Value = sh.Cells(row + i, colPos).Value
        End If
    Next i
End Sub

' Copy ResutlsPostions in Result

Sub CopyResultsPositionsResult2(sh, col, row)
    colPos = 3
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(98 + i, col).Value = sh.Cells(row + i, colPos).Value
        End If
    Next i
End Sub

' Copy ResutlsPostions in Multi Scenario

Sub CopyResultsNames2(sh, col, row)
    colPos = 4
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(107 + i, col).Value = sh.Cells(row + i, colPos).Value
        End If
    Next i
End Sub

' Copy ResutlsPostions in Result

Sub CopyResultsNamesResult2(sh, col, row)
    colPos = 4
    For i = 0 To 15
        If sh.Cells(row + i, colPos).Text = "" Then
            i = 15
        Else
            Sheets("Result").Cells(107 + i, col).Value = sh.Cells(row + i, colPos).Value
        End If
    Next i
End Sub

'Creates the Values for different percentages
Sub HistogramPercentages2(col, arr, freq, percentMat)
    Dim k, sum, rng, iteration As Long
    k = 0
    sum = 0
    
    iteration = Range("Iterations_result").Value
    rng = iteration / 20
   
    For i = 0 To 20
        Do While sum < (i * rng) And k < 40
            sum = sum + arr(k)
            k = k + 1
        Loop
        
        If k > 39 Then
            k = 39
        End If
        
        percentMat(i, col) = freq(k)
    Next i
    
End Sub