How to write VBA function activating different sheets? - excel

I'm writing a VBA function using an input that determines the sheet containing other inputs.
With different curvename, the function should refer to data in different sheets. My code is as below:
Public Function DFrate(mtmdate As Date, pmtdate As Date, curvename As String, colno As Integer) As Double
Dim yf As Double
Dim noday As Integer
Dim lastrow As Integer
Dim rate As Range
Dim tenor As Range
Dim DFinv As Double
Dim DFinv1 As Double
Dim DFinv2 As Double
noday = pmtdate - mtmdate
yf = noday / 360
MsgBox noday
ThisWorkbook.Sheets("HS_" & curvename).Activate
lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rate = ActiveSheet.Range(Cells(102, 3 + colno), Cells(lastrow, 3 + colno))
Set tenor = ActiveSheet.Range(Cells(102, 2), Cells(lastrow, 2))
If (noday <= tenor(1, 1)) Then
DFinv1 = (1 + rate(1, 1) / 100) ^ yf
DFinv2 = (1 + rate(2, 1) / 100) ^ yf
DFinv = DFinv1 + (noday - tenor(1, 1)) * (DFinv2 - DFinv1) / (tenor(2, 1) - tenor(1, 1))
MsgBox DFinv
End If
For k = 1 To lastrow
If (noday > tenor(k, 1) And noday <= tenor(k + 1, 1)) Then
DFinv1 = (1 + rate(k, 1) / 100) ^ (tenor(k, 1) / 360)
DFinv2 = (1 + rate(k + 1, 1) / 100) ^ (tenor(k + 1, 1) / 360)
DFinv = DFinv1 + (noday - tenor(k, 1)) * (DFinv2 - DFinv1) / (tenor(k + 1, 1) - tenor(k, 1))
Exit For
End If
Next k
DFrate = DFinv
End Function
I got the error #NAME?
Even the message box "Msgbox noday" does not work.
Can someone please let me know what should be changed in my code? Thanks!

If I:
put the code below (which is slightly different to yours) in a regular module (not Thisworkbook or any of the Sheet modules),
create a worksheet named "HS_O",
put 5 in cell B102 of worksheet "HS_O", put 3 in cell D102 of worksheet "HS_O"
and put =DFrate(TODAY(),TODAY(),"O",1) in any cell of any worksheet within Thisworkbook
I get a return value of 1. I think it works for me (and should work for you too in theory).
Option Explicit
Public Function DFrate(mtmdate As Date, pmtdate As Date, curvename As String, colno As Long) As Double
Dim yf As Double
Dim noday As Long
Dim lastrow As Long
Dim rate As Range
Dim tenor As Range
Dim DFinv As Double
Dim DFinv1 As Double
Dim DFinv2 As Double
Dim k As Long
noday = pmtdate - mtmdate
yf = noday / 360
' Maybe have a defensive check/guard
' or some return particular return value if sheet doesn't exist
With ThisWorkbook.Sheets("HS_" & curvename)
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rate = .Range(.Cells(102, 3 + colno), .Cells(lastrow, 3 + colno))
Set tenor = .Range(.Cells(102, 2), .Cells(lastrow, 2))
End With
If (noday <= tenor(1, 1)) Then
DFinv1 = (1 + rate(1, 1) / 100) ^ yf
DFinv2 = (1 + rate(2, 1) / 100) ^ yf
DFinv = DFinv1 + (noday - tenor(1, 1)) * (DFinv2 - DFinv1) / (tenor(2, 1) - tenor(1, 1))
MsgBox DFinv
End If
For k = 1 To lastrow
If (noday > tenor(k, 1) And noday <= tenor(k + 1, 1)) Then
DFinv1 = (1 + rate(k, 1) / 100) ^ (tenor(k, 1) / 360)
DFinv2 = (1 + rate(k + 1, 1) / 100) ^ (tenor(k + 1, 1) / 360)
DFinv = DFinv1 + (noday - tenor(k, 1)) * (DFinv2 - DFinv1) / (tenor(k + 1, 1) - tenor(k, 1))
Exit For
End If
Next k
DFrate = DFinv
End Function
I don't deal with calling UDFs from the worksheet much. Maybe merely calling the function activates the sheet the function is on, and not the "HS_" & curvename worksheet. I don't know for sure. Either way, we can use a With statement.

Related

Use IFERROR, INDEX, MATCH if the amount of column is limited

I would like to know if it would be possible to use the IFERROR, INDEX, MATCH function on below scenario.
D2:=INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0))
E2: =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), "")
H2: =IFERROR(INDEX($C$2:$C$16, MATCH(0, COUNTIF($D2:D2,$C$2:$C$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), "")
I2: =IFERROR(INDEX($C$2:$C$16, MATCH(0, COUNTIF($D2:H2,$C$2:$C$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), "")
Based on the data of Countries and Cities filled in yellow on the left, by using the IFERROR, INDEX, MATCH formula I managed to get all the data I need. Now if there are more than 3 City, I want for the excel to continue the list of cities by creating another row under it as example of row filled in red.
I hope it makes sence. Let me know if it's possible.
You did tag vba as well as excel-formula so give this a try
Sub condense()
Dim src, dest(), ws As Worksheet, srcRange As Range, i As Long, j As Long, countryCount As Long, rowNum As Long
Set ws = ActiveSheet
Set srcRange = ws.Cells(1, 1).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row, 3)
src = srcRange.Value2
ReDim dest(1 To UBound(src, 1) - 1, 1 To 7)
rowNum = 1
i = 2
Do While i <= UBound(src, 1)
countryCount = Application.CountIf(srcRange.Columns(1), src(i, 1))
For j = 1 To countryCount
dest(rowNum + Int((j - 1) / 3), 1) = src(i + j - 1, 1)
dest(rowNum + Int((j - 1) / 3), 2 + ((j - 1) Mod 3)) = src(i + j - 1, 2)
dest(rowNum + Int((j - 1) / 3), 5 + ((j - 1) Mod 3)) = src(i + j - 1, 3)
Next j
i = i + countryCount
rowNum = rowNum + 1 + Int((countryCount - 1) / 3)
Loop
ws.Cells(2, 4).Resize(rowNum, 7).Value2 = dest
With ws.Cells(1, 4).Resize(1, 7)
.Value2 = Strings.Split("Country,City1,City2,City3,Image1,Image2,Image3", ",")
.EntireColumn.AutoFit
End With
End Sub
EDIT 17-Jul-2022 (per comment from OP)
Sub condenseInto4cols()
Dim src, dest(), ws As Worksheet, srcRange As Range, i As Long, j As Long, countryCount As Long, rowNum As Long
Set ws = ActiveSheet
Set srcRange = ws.Cells(1, 1).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row, 3)
srcRange.Sort key1:=ws.Cells(2, 1), order1:=xlAscending, Header:=xlYes
src = srcRange.Value2
ReDim dest(1 To UBound(src, 1) - 1, 1 To 9)
rowNum = 1
i = 2
Do While i <= UBound(src, 1)
countryCount = Application.CountIf(srcRange.Columns(1), src(i, 1))
For j = 1 To countryCount
dest(rowNum + Int((j - 1) / 4), 1) = src(i + j - 1, 1)
dest(rowNum + Int((j - 1) / 4), 2 + ((j - 1) Mod 4)) = src(i + j - 1, 2)
dest(rowNum + Int((j - 1) / 4), 6 + ((j - 1) Mod 4)) = src(i + j - 1, 3)
Next j
i = i + countryCount
rowNum = rowNum + 1 + Int((countryCount - 1) / 4)
Loop
ws.Cells(2, 4).Resize(rowNum, 9).Value2 = dest
With ws.Cells(1, 4).Resize(1, 9)
.Value2 = Strings.Split("Country,City1,City2,City3,City4,Image1,Image2,Image3,Image4", ",")
.EntireColumn.AutoFit
End With
srcRange.Sort key1:=ws.Cells(2, 2), order1:=xlAscending, Header:=xlYes
End Sub

Excel return #Value! error for user defined function

I have written a function and when I call it in Excel, it returns me #value! error.
Function interpolator(maturities As Variant, rates As Variant, currencies As Variant, ccy As String, t_end As Double)
Dim xArr() As Double
Dim yArr() As Double
Dim xLen As Integer, currLen As Integer
xLen = UBound(maturities) - LBound(maturities) + 1
currLen = UBound(currencies) - LBound(currencies) + 1
ReDim xArr(1 To xLen, 1)
ReDim yArr(1 To xLen, 1)
'defining and filling the arrays with inputs
Dim m As Integer, k As Integer
m = 1
For k = 1 To currLen
If currencies(k, 1) = ccy Then
xArr(m, 1) = CInt(maturities(m, 1))
yArr(m, 1) = CDbl(rates(k, 1))
m = m + 1
End If
Next
' Check tenor is within range, then execute
If t_end = xArr(LBound(xArr), 1) Then
interpolator = yArr(LBound(yArr), 1)
Else
Dim n As Integer
For n = 1 To xLen
If xArr(n, 1) >= t_end Then
interpolator = yArr(n - 1, 1) + ((t_end - xArr(n - 1, 1)) * (yArr(n, 1) - yArr(n - 1, 1)) / (xArr(n, 1) - xArr(n - 1, 1)))
Exit For
End If
Next
End If
End Function
Sub test()
Dim maturities As Variant, rates As Variant, currencies As Variant
maturities = Worksheets("Static Data").ListObjects("Table_TenorTable").ListColumns("days").DataBodyRange.Value2
rates = Worksheets("Static Data").ListObjects("Table_TenorTable20").ListColumns("CCYYield").DataBodyRange.Value
currencies = Worksheets("Static Data").ListObjects("Table_TenorTable20").ListColumns("Currency").DataBodyRange.Value
MsgBox interpolator(maturities, rates, currencies, "USD", 31)
End Sub
interpolator(maturities, rates, currencies, "USD", 31) works fine but when I call it via Excel, it give me error.
I am calling in Excel like this:
=interpolator(Table_TenorTable[days],Table_TenorTable20[CCYYield],Table_TenorTable20[Currency],LEFT([#[Commodity_Group]],3),[#[T (in Tenors)]])
Need some guidance in solving this.

How transform Variant to Double format and vice versa in VBA

When I want to import data using VBA I use following command
Dim FinalArray As Variant
ArrayData = Range("DATA").Value
I also tried doing with the loop, but got error in this place (newData (0, newii))
Dim Data As Variant
Dim newData As Double
Dim i As Long
Data= Range("horiz2").Value
For i= 0 To 11 Step 1
newData (0, newii) = Data(1, i+1)
Next i
When I run this code, I have data stored as Variant/Variant (1 to 1, 1 to 12) type.
At the same time, I notice that while doing some calculations inside the macro, I have a table X where the same values are in Double(0 to 0, 0 to 11) type.
How can I import data from a range in Double format - (Double(0 to 0, 0 to 11) to Variant/Variant (1 to 1, 1 to 12))
How can I transform the table in Double format to Variant (Variant/Variant (1 to 1, 1 to 12) to Double(0 to 0, 1 to 12))?
You will need to loop the arrays to transform them as needed. Here are some helper functions to aid in this endeavor:
Private Function VariantArrayToDoubleArray(ByRef VariantArray As Variant) As Double()
Dim i As Integer
Dim j As Integer
Dim da() As Double
ReDim da(LBound(VariantArray, 1) - 1 To UBound(VariantArray, 1) - 1, _
LBound(VariantArray, 2) - 1 To UBound(VariantArray, 2) - 1)
For i = LBound(VariantArray, 1) To UBound(VariantArray, 1)
For j = LBound(VariantArray, 2) To UBound(VariantArray, 2)
da(i - 1, j - 1) = VariantArray(i, j)
Next
Next
VariantArrayToDoubleArray = da
End Function
Private Function DoubleArrayToVariantArray(ByRef DoubleArray() As Double) As Variant
Dim i As Integer
Dim j As Integer
Dim va() As Variant
ReDim va(LBound(DoubleArray, 1) + 1 To UBound(DoubleArray, 1) + 1, _
LBound(DoubleArray, 2) + 1 To UBound(DoubleArray, 2) + 1)
For i = LBound(DoubleArray, 1) To UBound(DoubleArray, 1)
For j = LBound(DoubleArray, 2) To UBound(DoubleArray, 2)
va(i + 1, j + 1) = DoubleArray(i, j)
Next
Next
DoubleArrayToVariantArray = va
End Function
Here's how to use the helper functions:
Private Sub Test()
Dim va(1 To 1, 1 To 12) As Variant
va(1, 1) = 4
va(1, 2) = 42
va(1, 3) = 52
Dim da() As Double
da = VariantArrayToDoubleArray(va)
Dim va2 As Variant
va2 = DoubleArrayToVariantArray(da)
End Sub

Outputting a graph in VBA based off an inputted range

I'm trying to get my VBA code to output a graph in excel based on an inputted range that was selected using a user defined function from multiple cells. I've passed the data to the sub as a range but it ends up assuming that the range is two data sets rather than one data set with x and y values. The data set is selected from excel into a function that is being written separately which then calls the sub.
Sub CreateChart(ByRef r As Range)
Dim cht As Object
Set cht = ActiveSheet.Shapes.AddChart2
cht.Chart.SetSourceData Source:=r
cht.Chart.ChartType = xlXYScatterLines
End Sub
I called the sub through
Call CreateChart(r)
with r being a two column range of data that was selected from excel.
Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
The overall function code is here as well
Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
Dim data() As Double
Dim check1 As Integer
Dim Smatrix() As Double
Dim Tmatrix() As Double
Dim Xmatrix() As Double
Dim Amatrix() As Double
Dim Hmatrix() As Double
Dim m As Integer
Dim i As Integer
m = r.Rows.Count
ReDim data(1 To m, 2)
ReDim Smatrix(1 To m, 1 To m)
ReDim Tmatrix(1 To m, 4)
ReDim Xmatrix(1 To m)
ReDim Amatrix(1 To m - 1, 1 To 4)
ReDim Hmatrix(1 To m)
check1 = Test(check)
For i = 1 To m
data(i, 1) = r(i, 1).Value
data(i, 2) = r(i, 2).Value
Next i
Smatrix(1, 1) = 1
Smatrix(m, m) = 1
For i = 1 To m - 1
Hmatrix(i) = data(i + 1, 1) - data(i, 1)
Next i
If check1 = 2 Then
Smatrix(1, 2) = -1
Smatrix(m, m - 1) = -1
End If
For i = 2 To m - 1
Smatrix(i, i - 1) = Hmatrix(i - 1)
Smatrix(i, i + 1) = Hmatrix(i)
Smatrix(i, i) = 2 * (Hmatrix(i - 1) + Hmatrix(i))
Next i
For i = 2 To m - 1
Tmatrix(i, 4) = 6 * ((data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - (data(i, 2) - data(i - 1, 2)) / Hmatrix(i - 1))
Next i
For i = 1 To m
If i <> 1 Then
Tmatrix(i, 1) = Smatrix(i, i - 1)
End If
Tmatrix(i, 2) = Smatrix(i, i)
If i <> m Then
Tmatrix(i, 3) = Smatrix(i, i + 1)
End If
Next i
For i = 2 To m
Tmatrix(i, 1) = Tmatrix(i, 1) / Tmatrix(i - 1, 2)
Tmatrix(i, 2) = Tmatrix(i, 2) - Tmatrix(i, 1) * Tmatrix(i - 1, 3)
Tmatrix(i, 4) = Tmatrix(i, 4) - Tmatrix(i, 1) * Tmatrix(i - 1, 4)
Next i
Xmatrix(m) = Tmatrix(m, 4) / Tmatrix(m, 2)
For i = m - 1 To 1 Step -1
Xmatrix(i) = (Tmatrix(i, 4) - Tmatrix(i, 3) * Xmatrix(i + 1)) / Tmatrix(i, 2)
Next i
For i = 1 To m - 1
Amatrix(i, 1) = (Xmatrix(i + 1) - Xmatrix(i)) / 6 * Hmatrix(i)
Amatrix(i, 2) = Xmatrix(i) / 2
Amatrix(i, 3) = (data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - Hmatrix(i) * Xmatrix(i) / 2 - Hmatrix(i) * (Xmatrix(i + 1) - Xmatrix(i)) / 6
Amatrix(i, 4) = data(i, 2)
Next i
If x < data(1, 1) Or x > data(m, 1) Then
Call Check2(x)
If x < data(1, 1) Then
cubic = Amatrix(1, 1) * (x - data(1, 1)) ^ 3 + Amatrix(1, 2) * (x - data(1, 1)) ^ 2 + Amatrix(1, 3) * (x - data(1, 1)) + Amatrix(1, 4)
ElseIf x > data(m, 1) Then
cubic = Amatrix(m - 1, 1) * (x - data(m - 1, 1)) ^ 3 + Amatrix(m - 1, 2) * (x - data(m - 1, 1)) ^ 2 + Amatrix(m - 1, 3) * (x - data(m - 1, 1)) + Amatrix(m - 1, 4)
End If
ElseIf x = data(m, 1) Then
cubic = data(m, 2)
Else
For i = 1 To m - 1
If data(i, 1) < x And x < data(i + 1, 1) Then
cubic = Amatrix(i, 1) * (x - data(i, 1)) ^ 3 + Amatrix(i, 2) * (x - data(i, 1)) ^ 2 + Amatrix(i, 3) * (x - data(i, 1)) + Amatrix(i, 4)
ElseIf x = data(i, 1) Then
cubic = data(i, 2)
End If
Next i
End If
Call CreateChart(r)
End Function
As well as the subroutine and function called within the function that haven't been posted
Public Function Test(check As Integer) As Integer
Dim Response As Integer
If check = 1 Then
Response = MsgBox("Boundary Condition 1 selected, is this correct (select No for boundary condition 2)?", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 1
Else
Test = 2
End If
ElseIf check = 2 Then
Response = MsgBox("Boundary Condition 2 selected, is this correct (select No for boundary condition 1)?", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 2
Else
Test = 1
End If
Else
Response = MsgBox("Incorrect Boundary Condition, select Yes for condition 1 and No for condition 2", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 1
Else
Test = 2
End If
End If
End Function
Public Sub Check2(x)
MsgBox ("Value given is outside data range, answer may not be correct, extrapolating from calculated polynomial")
End Sub
Try
Sub CreateChart(ByRef r As Range)
Dim cht As Object
Set cht = ActiveSheet.Shapes.AddChart2(XlChartType:=xlXYScatterSmooth)
cht.Chart.SetSourceData Source:=r
End Sub

selecting max value excel using Cells(x,y) as input

How do you call the Max function in VBA using a range of Cells (x,y) as input?
E.g., I have two variables, m & n, where n > m
I try to find the Max value within a range of cells using the following code:
Cells(Count, 4) = Application.WorksheetFunction.Max(Cells(m, 1): Cells(n, 1))
Using that code I keep getting an error "Expected: list separator or )"
Edit, here is the entire code
Sub convertFNIRStoCandlesticks()
'Variable declarations
Dim rowCount As Integer 'The total number of rows in use
Dim Count As Integer
Dim Period As Integer
Dim totalPeriods As Integer
Dim PeriodStart As Integer
Dim PeriodEnd As Integer
rowCount = ActiveSheet.UsedRange.Rows.Count
totalPeriods = rowCount / 6
Sheets("Sheet1").Activate
For Count = 1 To totalPeriods
Period = Count - 1
PeriodStart = (Period * 6) + 1
m = (Period * 6) + 1
PeriodEnd = (Period * 6) + 6
n = PeriodEnd
Cells(Count, 2) = Cells(PeriodStart, 1)
Cells(Count, 4) = Application.WorksheetFunction.Min(Range(Cells(PeriodStart, 1), Cells(PeriodEnd, 1)))
Cells(Count, 5) = Cells(PeriodEnd, 1)
Next Count
End Sub
You can use the function Max on Application.WorksheetFunction where you use a Range from Cells(m, 1) to Cells(n, 1):
Cells(Count, 4)=Application.WorksheetFunction.Max(Range(Cells(m, 1),Cells(n, 1)))
This will return max into Cells(Count, 4)

Resources