Sub CalculateTax()
Dim interest As Double
Dim capital As Double
Dim days As Integer
Dim loopCounter As Integer
Dim numRows As Integer
Dim start_date As Date
Dim end_date As Date
Dim rate As Double
Dim currentRateRow As Integer
'Select Sheet
Sheets("Tabelle1").Select
'Select Table
Dim oSh As Worksheet
Set oSh = ActiveSheet
'Select the first column and count the rows
numRows = oSh.Range("Kontodaten[Name]").Rows.Count
capital = 0
interest = 0
loopCounter = 0
days = 0
currentRateRow = 1
'We start with the first rate of our table
rate = oSh.Range("Zinsänderung[Zinssatz]").Rows(currentRateRow) * 100
Do
capital = capital + Cells(loopCounter + 7, 3)
start_date = Cells(loopCounter + 7, 4)
'Check if we have reached the end of our table
If (loopCounter = (numRows - 1)) Then
end_date = Date
Else
If ((Cells(loopCounter + 8, 4)) = DateSerial(VBA.DateTime.Year(start_date), 12, 31)) Then
end_date = Cells(loopCounter + 8, 4) - 1
Else
end_date = Cells(loopCounter + 8, 4)
End If
End If
'This will check if there occurs any rate changes between our two dates
Do While (RateChanged(end_date, currentRateRow) = True)
currentRateRow = currentRateRow + 1
'Calculate until rate change date
days = WorksheetFunction.Days360(start_date, oSh.Range("Zinsänderung[Datum]").Rows(currentRateRow))
If (days > 0) Then
interest = interest + ((capital * rate * days) / (36000))
End If
start_date = oSh.Range("Zinsänderung[Datum]").Rows(currentRateRow)
'Change rate factor to our new rate
rate = oSh.Range("Zinsänderung[Zinssatz]").Rows(currentRateRow) * 100
Loop
days = WorksheetFunction.Days360(start_date, end_date)
If (days > 0) Then
interest = interest + ((capital * rate * days) / (36000))
End If
loopCounter = loopCounter + 1
Loop While loopCounter < numRows
Range("G11").Select
ActiveCell.FormulaR1C1 = interest
End Sub
Sub CalculateTaxYear()
Dim interest As Double
Dim capital As Double
Dim days As Integer
Dim loopCounter As Integer
Dim numRows As Integer
Dim start_date As Date
Dim end_date As Date
Dim rate As Double
Dim currentRateRow As Integer
'Select Sheet
Sheets("Tabelle1").Select
'Select Table
Dim oSh As Worksheet
Set oSh = ActiveSheet
'Select the first column and count the rows
numRows = oSh.Range("Kontodaten[Name]").Rows.Count
capital = 0
interest = 0
loopCounter = 0
days = 0
currentRateRow = 1
'We start with the first rate of our table
rate = oSh.Range("Zinsänderung[Zinssatz]").Rows(currentRateRow) * 100
Do
capital = capital + Cells(loopCounter + 7, 3)
start_date = Cells(loopCounter + 7, 4)
'Check if we have reached the end of our table
If (loopCounter = (numRows - 1)) Then
end_date = DateSerial(VBA.DateTime.Year(start_date), 12, 31)
Else
If ((Cells(loopCounter + 8, 4)) = DateSerial(VBA.DateTime.Year(start_date), 12, 31)) Then
end_date = Cells(loopCounter + 8, 4) - 1
Else
end_date = Cells(loopCounter + 8, 4)
End If
End If
'This will check if there occurs any rate changes between our two dates
Do While (RateChanged(end_date, currentRateRow) = True)
currentRateRow = currentRateRow + 1
'Calculate until rate change date
days = WorksheetFunction.Days360(start_date, oSh.Range("Zinsänderung[Datum]").Rows(currentRateRow))
If (days > 0) Then
interest = interest + ((capital * rate * days) / (36000))
End If
start_date = oSh.Range("Zinsänderung[Datum]").Rows(currentRateRow)
'Change rate factor to our new rate
rate = oSh.Range("Zinsänderung[Zinssatz]").Rows(currentRateRow) * 100
Loop
days = WorksheetFunction.Days360(start_date, end_date)
If (days > 0) Then
interest = interest + ((capital * rate * days) / (36000))
End If
loopCounter = loopCounter + 1
Loop While loopCounter < numRows
Range("G12").Select
ActiveCell.FormulaR1C1 = interest
End Sub
'Check if date is greater than the next rate upgrade date
Function RateChanged(endOfDate As Date, rowNumber As Integer) As Boolean
Dim tempDate As Date
'Select Table
Dim oSz As Worksheet
Set oSz = ActiveSheet
If ((rowNumber + 1) > (oSz.Range("Zinsänderung[Datum]").Rows.Count)) Then
RateChanged = False
Else
tempDate = oSz.Range("Zinsänderung[Datum]").Rows(rowNumber + 1)
If (endOfDate < tempDate) Then
RateChanged = False
Else
RateChanged = True
'MsgBox "Rate Changed"
End If
End If
End Function
