I am working with VBA for Excel.
I get the "Application defined or object defined" error each time I run this code.
Here it is:
Sub Test()
Dim i As Integer, j As Integer, k As Integer, l As Integer, t As Integer
Dim row As Integer
Dim Maturite As Integer
Dim tsup As Double, tinf As Double
Dim datetaux As Date, datejouissance As Date
Dim taux As Double
For i = 2 To 770
Maturite = Sheets("Em").Cells(i, 19)
datejouissance = Sheets("Em").Cells(i, 14)
For l = 2 To 255
For k = 0 To 10
For t = 1 To 10
row = 13 * k + 2
datetaux = Sheets("TSR").Cells(row, l)
taux = Sheets("TSR").Cells(13 * k + 3, l)
If taux <> 0 Then
If datejouissance = datetaux Then
If 91 <= Maturite And Maturite <= 182 Then
tsup = Sheets("TSR").Cells(row + 2, j)
tinf = Sheets("TSR").Cells(row + 1, j)
Sheets("Em").Cells(i, 21).Value = ((tsup - tinf) * (Maturite - 91) / (182 - 91)) + tinf
End If
End If
End If
Next
Next
Next
Next
End Sub
I get the error at :
tsup = Sheets("TSR").Cells(row + 2, j)
I tried using :
tsup = Sheets("TSR").Cells(row + 2, j).Value
The type of Sheets("TSR").Cells(row + 2, j).Value is Double.
But it's not working. I can't seem to understand what the problem is.
Thanks in advance
I think you may need to check the value of j. As far as I can see from your code its value remains 0. Column 0 does not exist and will lead to the given error.
You address the cell using the integer j, but you don't assign a value to j.
Thus, VBA fills it with the standart value for integers: 0, directing your call to Sheets("TSR").Cells(row + 2, 0) and producing an error.
Related
I have the below VBA code which calculates a number of output values and stores them in as an array (beginning_gross_facility_balance being one of the examples).
when I try to print the resulting array values into excel (to output2 range, which is C16:J515 in an excel tab, the array is exported/printed into column D and from row 17.
currently, i = 1 and j = 25
grateful if someone could shine some light on why this is happening/how can I ensure that the output is copied into the first column and first row of the range
Sub AssetProjection2()
Application.ScreenUpdating = False
'pluming variables
Dim i As Integer
Dim j As Integer
Dim Period As Integer
Dim numberOfLoans As Integer
numberOfLoans = WorksheetFunction.CountA(Range("LoanCount")) - 1
ReDim tape(numberOfLoans)
Dim pool_lag As Double
Dim total_gross_facility_limit As Double
Dim beginning_gross_facility_balance(500, 500) As Double
Dim interest_rate As Double
Dim arrangement_fee As Double
Dim admin_fee As Double
Dim Audit_fee As Double
Dim insurance_fee As Double
Dim exit_fee As Double
Dim loan_term As Double
Dim loan_remaining_term As Double
Dim default_flag As String
Dim GDV As Double
'only relevant for loans with no seasoning
Dim first_tranche_percentage As Double
Dim seasoning As Double
Dim adjustment_factor As Double
Dim development_fees As Double
Dim lag As Double
Dim sev As Double
'temps/ output variables on a loan by loan basis (so i can call info from any period and any loan)
Dim pmt As Double
Dim Recovery As Double
Dim TempDefault(500, 500) As Double
'end of period balance is the cumulative gross facility at any given point, at maturity, this should match total gross loan limit
Dim end_of_period_gross_balance(500, 500) As Double
Dim periodic_interest(500, 500) As Double
Dim cumulative_retained_interest(500, 500) As Double
Dim periodic_gross_drawdown(500, 500) As Double
Dim periodic_net_advance(500, 500) As Double
Dim cumulative_net_advance(500, 500) As Double
'the loan redeems in one go, then principal and interest redemptions are split for transparency
Dim total_facility_repayment(500, 500) As Double
Dim principal_redemption(500, 500) As Double
Dim interest_redemption(500, 500) As Double
'pristine/stressed variables
Dim prin As Double
Dim prepay As Double
'scenarios
Dim DefScen As Integer
Dim PrepScen As Integer
Dim SevScen As Integer
Dim LagScen As Integer
Dim IRScen As Integer
'ouput variables
'the below is currently not being used
Dim oBegBalance(500) As Double
Dim oEndBalance(500) As Double
Dim oDefault(500) As Double
Dim oInterest(500) As Double
Dim oPrincipal(500) As Double
Dim oPrepayment(500) As Double
Dim oRecovery(500) As Double
Dim oAccrued(500) As Double
Dim oCumTheoreticalDef(500) As Double
'initialise CF time
Period = 1
pool_lag = Range("total_lag").Value
'this loop will project asset cashflows assuming non-seasonality, then the next loop will look-up the figures for each loan based on the loan's seasonality
For i = 1 To numberOfLoans
SevScen = Range("severity_scen").Cells(i + 1)
LagScen = Range("lag_scen").Cells(i + 1)
'IR scenario currently not in use, when floating interest is modelled, this will be already plugged in
IRScen = Range("IR_scen").Cells(i + 1)
interest_rate = Range("interest_rate").Cells(i + 1)
loan_remaining_term = Range("loan_remaining_term").Cells(i + 1)
loan_term = Range("loan_term").Cells(i + 1)
seasoning = loan_term - loan_remaining_term
first_tranche_percentage = Range("first_tranche_percentage").Cells(i + 1)
total_gross_facility_limit = Range("total_gross_limit").Cells(i + 1)
adjustment_factor = 1.1
admin_fee = Range("admin_fee").Cells(i + 1)
default_flag = Range("default_flag").Cells(i + 1)
For j = 1 To loan_term + pool_lag
lag = Range("LagScenarios").Cells(loan_term + j + 4, LagScen)
sev = Range("severityScenarios").Cells(loan_term + j + 4, SevScen)
If j = 1 Then
arrangement_fee = Range("arrangement_fee").Cells(i + 1)
Audit_fee = Range("Audit_fee").Cells(i + 1)
insurance_fee = Range("insurance_fee").Cells(i + 1)
Else
arrangement_fee = 0
Audit_fee = 0
insurance_fee = 0
End If
If j = loan_term Then
exit_fee = Range("exit_fee").Cells(i + 1)
Else
exit_fee = 0
End If
development_fees = arrangement_fee + Audit_fee + insurance_fee + admin_fee
Recovery = 0
'term is original term, not really used anywhere at the moment, only as a static figure to work out seasonality for input curves
loan_term = Range("loan_term").Cells(i + 1)
'remaining term doesnt need to be dynamic as the PMT formula takes the current J into account to work out the dynamic remaining term
loan_remaining_term = Range("loan_remaining_term").Cells(i + 1)
interest_rate = Range("interest_rate").Cells(i + 1)
If j = 1 Then
beginning_gross_facility_balance(i, j) = total_gross_facility_limit * first_tranche_percentage
Else
beginning_gross_facility_balance(i, j) = end_of_period_gross_balance(i, j - 1)
End If
'gross drawdown. if first disbursment, it's first_tranche_percentage, else, it's a fixed figure such that from month 2 to maturity, the total gross facility equals the gross loan limit. for the model, I will start with a basic number and learn how to apploy a goal seek/solver figure
'draws happen at the beginning of the period and so every period's accrued interest is on the end of period balance J - 1 + period J further draw (J=1 has end of previous period as 0 bcs the loan is new
If j = 1 Then
periodic_gross_drawdown(i, j) = 0
Else
If j < loan_term Then
periodic_gross_drawdown(i, j) = (total_gross_facility_limit - periodic_gross_drawdown(i, 1)) / (loan_term - 2) / adjustment_factor
Else
periodic_gross_drawdown(i, j) = 0
End If
End If
If j = 1 Then
periodic_net_advance(i, j) = beginning_gross_facility_balance(i, j) - development_fees
Else
periodic_net_advance(i, j) = periodic_gross_drawdown(i, j) - development_fees
End If
If j = 1 Then
cumulative_net_advance(i, j) = periodic_net_advance(i, j)
Else
cumulative_net_advance(i, j) = cumulative_net_advance(i, j - 1) + periodic_net_advance(i, j)
End If
periodic_interest(i, j) = (beginning_gross_facility_balance(i, j) + periodic_gross_drawdown(i, j)) * interest_rate
end_of_period_gross_balance(i, j) = beginning_gross_facility_balance(i, j) + periodic_interest(i, j)
If j = loan_term And default_flag = "N" Then
total_facility_repayment(i, j) = end_of_period_gross_balance(i, j)
principal_redemption(i, j) = cumulative_net_advance(i, j)
interest_redemption(i, j) = total_facility_repayment(i, j) - principal_redemption(i, j)
Else
total_facility_repayment(i, j) = 0
principal_redemption(i, j) = 0
interest_redemption(i, j) = 0
End If
If j = loan_term + lag And default_flag = "Y" Then
Recovery = total_facility_repayment(i, j - lag) * (1 - sev) 'accrue some defaulted int rate or keep it simple?
Else
Recovery = 0
End If
Next j
Next i
'write it out
'Range("beginning_balance_output") = WorksheetFunction.Transpose(beginning_gross_facility_balance)
Range("output2") = WorksheetFunction.Transpose(beginning_gross_facility_balance)
' Range("output2").Columns(3) = WorksheetFunction.Transpose(periodic_net_advance)
'Range("output2").Columns(4) = WorksheetFunction.Transpose(cumulative_net_advance)
' Range("output2").Columns(5) = WorksheetFunction.Transpose(total_facility_repayment)(end_of_period_gross_balance)
End Sub
Your problem is that you don't declare the lower bound of the arrays. Per default, VBA set the lower bound to 0, but you don't use the 0th row and/or column in your code.
If you write Dim TempDefault(500, 500) As Double, the 500 is used as upper bound, giving you an array of 501 x 501 (from 0 to 500) elements.
You can do the following:
(a) Declare the arrays like this:
Dim TempDefault(1 to 500, 1 to 500) As Double
(b) Rewrite your code to that it deals with the 0-row and column of the array
(c) Put the following statement at the top of the module:
Option Base 1
That will force the compiler to use 1 as lower bound if omitted at the declaration.
I would advice to use the first option and always declare the lower and upper bounds.
I have a workbook where I want to find the differences of two sheets by looking at the company name and their corporate registration number and then type the differences on the third sheet.
I have tried the code in another workbook with only 143 rows, which works perfectly, but when I try it on the real workbook with 10,000 rows I get a "type mismatch error". Also if I use other columns than the CVR and Firm columns the code also works.
The CVR is numbers and Firms are strings (firm names). I get the
type mismatch error
on the line I marked **. Does somebody know why I get this error?
Sub ComCVR()
Dim CVR1()
Dim CVR2()
Dim Firm1()
Dim Firm2()
Dim n As Long, m As Long
Dim i As Double, j As Double
Dim intCurRow1 As Integer, intCurRow2 As Integer
Dim rng As Range, rng1 As Range
Set rng = ThisWorkbook.Sheets("Last month").Range("A11")
Set rng1 = ThisWorkbook.Sheets("Current month").Range("A11")
n = rng.CurrentRegion.Rows.Count
m = rng1.CurrentRegion.Rows.Count
ReDim CVR1(n)
ReDim Firm1(n)
ReDim CVR2(m)
ReDim Firm2(m)
ThisWorkbook.Sheets("CVR").Range("A1") = "Flyttet CVR"
ThisWorkbook.Sheets("CVR").Range("B1") = "Flyttet Firmanavn"
ThisWorkbook.Sheets("CVR").Range("A1:B1").Interior.ColorIndex = 3
ThisWorkbook.Sheets("CVR").Range("C1") = "Nye CVR"
ThisWorkbook.Sheets("CVR").Range("D1") = "Nye Firmanavn"
ThisWorkbook.Sheets("CVR").Range("C1:D1").Interior.ColorIndex = 4
ThisWorkbook.Sheets("CVR").Range("A1:D1").Font.Bold = True
' Inset data to arrays
For i = 0 To n
CVR1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 5)
Firm1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Next
For i = 0 To m
CVR2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 5)
Firm2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 4)
Next
intCurRow1 = 2
intCurRow2 = 2
'Old
For i = 0 To n
For j = 0 To m
If Firm1(i) = ThisWorkbook.Sheets("Current month").Cells(12 + j, 4) Then '** Error raised here
Exit For
End If
If j = m Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 1) = CVR1(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 2) = Firm1(i)
intCurRow1 = intCurRow1 + 1
End If
Next j
Next i
'new
For i = 0 To m
For j = 0 To n
If Firm2(i) = ThisWorkbook.Sheets("Last month").Cells(12 + j, 4) Then
Exit For
End If
If j = n Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 3) = CVR2(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 4) = Firm2(i)
intCurRow2 = intCurRow2 + 1
End If
Next j
Next i
Columns("A:B").Select
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
Columns("C:D").Select
ActiveSheet.Range("$C:$D").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
End Sub
Whenever an error happens, the best way is to google it. This is what it says in the documentation of VBA for Type mismatch:
Cause: The variable or property isn't of the correct type. For example, a variable that requires an integer value can't accept a string value unless the whole string can be recognized as an integer.
In the case of the code, it happens, when an array is compared with excel cell. Now the trick - in order to see why it happens, see what is in these:
Debug.Print ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Debug.Print Firm1(i)
and the after the error runs, take a look at the immediate window (Ctrl+G). It it quite possible, that there is an error in the excel cell, thus it cannot be compared. This is some easy way to avoid it, if this is the case:
Sub TestMe()
Dim myRange As Range
Set myRange = Worksheets(1).Cells(1, 1)
myRange.Formula = "=0/0"
If Not IsError(myRange) Then
Debug.Print CBool(myRange = 2)
Else
Debug.Print myRange.Address; " is error!"
End If
End Sub
The aim of this code is to have the user input that they want an, e.g. 4x10 grid. I have attached a photo below of the desired output.
However, I'm stuck on the logic of the problem. I can generate one set of grid numbers (e.g. 1-25), but unsure how to duplicate this process to create the whole grid.
Hard to explain using words....
In short I am aiming for:
A1, A2, A3, A4, B1, B2, B3, B4 ...
But I am currently getting: A1, B2, C3, D4 ...
Tried experimenting with different code but to no success. Current code has a loop that I think is right in principle, but re-writes the data in the rows above it once it finishes one 'j' loop and goes back to the start. I'm not sure how to get 'j' to start on a blank cell rather than overwrite what is already in it.
['Userform prior to this step gathers user input
Dim Axial_Data_Points As Variant
Dim Circum_Data_Points As Variant
Axial_Data_Points = Axial_Data_Points_Box.Value 'User input value
Circum_Data_Points = Circum_Data_Points_Box.Value 'User input value
'Basic loop to generate a list of numbers up to the user imposed limit
For j = 1 To Axial_Data_Points
Worksheets("Data Entry").Activate
For k = 1 To Circum_Data_Points
Range("E" & ((j + k) + 1)).Select
ActiveCell.FormulaR1C1 = j
Next k
Next j]
1
This will produce output like:
Dim Axial_Data_Points As Variant
Dim Circum_Data_Points As Variant
Axial_Data_Points = Axial_Data_Points_Box.Value 'User input value
Circum_Data_Points = Circum_Data_Points_Box.Value 'User input value
'Basic loop to generate a list of numbers up to the user imposed limit
Dim i As Integer
Dim j As Integer
For i = 1 To Axial_Data_Points
For j = 1 To Circum_Data_Points
Worksheets("Data Entry").Cells(j + (i - 1) * 10, 4).Value = Chr(i + 64)
Worksheets("Data Entry").Cells(j + (i - 1) * 10, 5).Value = j
Next j
Next i
End Sub
Using Something of this type you can generate what you require:
j = 1
k = 1
For i = 1 To 200
If j < 27 Then
Range("A" & i).Value = Chr(j + 64)
j = j + 1
ElseIf j > 26 And j < 53 Then
G:
Range("A" & i).Value = Chr(k + 64) & Chr(j - 26 + 64)
j = j + 1
Else
j = 27
k = k + 1
GoTo G
End If
Next
You will have to put it in your code.
For example, I have numbers 1,9,7,4 and I want to randomize their position so I will get 9,1,4,7 or 7,1,9,4 etc. Do you know how? Thanks
Here is a basic vba randomize into a dictionary object.
Dim vals As Variant, ord As Object
Set ord = CreateObject("scripting.dictionary")
vals = Array(1, 4, 7, 9)
Do While ord.Count < (UBound(vals) + 1)
ord.Item(vals(Application.RandBetween(LBound(vals), UBound(vals)))) = vbNullString
Loop
Debug.Print Join(ord.keys, ", ")
Here's a more likely (simplistic) example: (I hope I didn't do your homework for you)
Sub sub1()
Dim i1&, i2&, iswap&, a4 As Variant
a4 = Array(1, 9, 7, 4)
For i1 = 0 To 3
i2 = Int(Rnd() * 4) ' random integer 0 to 3
iswap = a4(i1) ' swap(a4(i1), a4(i2))
a4(i1) = a4(i2)
a4(i2) = iswap
Next i1
Debug.Print a4(0); a4(1); a4(2); a4(3) ' Ctl-G to view, F7 to get back to code
End Sub
You didn't specify the basic dialect so here is some code:
a(1) = 1 : a(2) = 4 : a(3) = 7 : a(4) = 9
FOR l = 1 TO 4
SWAP a(l), a(INT(RND * 4 + 1))
NEXT
END
I have data stored in some column (Say, Column A). The length of Column A is not fixed (depends on previous steps in the code).
I need a histogram for the values in Column A, and have it in the same sheet. I need to take the values in column A, and automatically compute M Bins, then give the plot.
I looked online for a "simple" code, but all codes are really fancy, with tons of details that I don't need, to the extent that I am not even able to use it. (I am a VBA beginner.)
I found the following code that seems to do the job, but I am having trouble even calling the function. Besides, it only does computations but does not make the plot.
Sub Hist(M As Long, arr() As Single)
Dim i As Long, j As Long
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Single
For i = 1 To M
freq(i) = 0
Next i
Length = (arr(UBound(arr)) - arr(1)) / M
For i = 1 To M
breaks(i) = arr(1) + Length * i
Next i
For i = 1 To UBound(arr)
If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
For j = 2 To M - 1
If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
Next j
Next i
For i = 1 To M
Cells(i, 1) = breaks(i)
Cells(i, 2) = freq(i)
Next i
End Sub
And then I try to call it simply by:
Sub TestTrial()
Dim arr() As Variant
Dim M As Double
Dim N As Range
arr = Range("A1:A10").Value
M = 10
Hist(M, arr) ' This does not work. Gives me Error (= Expected)
End Sub
A little late but still I want to share my solution. I created a Histogram function which might be used as array formula in the excel spread sheet. Note: you must press
CTRL+SHIFT+ENTER to enter the formula into your workbook. Input is the range of values and the number M of bins for the histogram. The output range must have M rows and two columns. One column for the bin value and one column for the bin frequency.
Option Explicit
Option Base 1
Public Function Histogram(arr As Range, M As Long) As Variant
On Error GoTo ErrHandler
Dim val() As Variant
val = arr.Value
Dim i As Long, j As Integer
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Integer
Dim min As Single
min = WorksheetFunction.min(val)
Dim max As Single
max = WorksheetFunction.max(val)
Length = (max - min) / M
For i = 1 To M
breaks(i) = min + Length * i
freq(i) = 0
Next i
For i = 1 To UBound(val)
If IsNumeric(val(i, 1)) And Not IsEmpty(val(i, 1)) Then
If val(i, 1) > breaks(M) Then
freq(M) = freq(M) + 1
Else
j = Int((val(i, 1) - min) / Length) + 1
freq(j) = freq(j) + 1
End If
End If
Next i
Dim res() As Variant
ReDim res(M, 2)
For i = 1 To M
res(i, 1) = breaks(i)
res(i, 2) = freq(i)
Next i
Histogram = res
ErrHandler:
'Debug.Print Err.Description
End Function
Not 100% sure as to the efficacy of that approach but;
Remove the parens as your calling a sub; Hist M, arr
M is declared as double but received by the function as a long; this won't work so declare it in the calling routine as long
You will need to recieve arr() As Variant
Range -> Array produces a 2 dimensional array so the elements are arr(1, 1) .. arr(n, 1)