Assign Different Formulas To Cells According By Criteria - excel

Question

I have written a code in which I am trying to use two different formulas with a set of conditions like if we take RUZ currency into consideration. where we have tenors between (SW- 1Y), the formula should be =1/(1/R208C[-5]+RC12/10000) and for the rest of the tenors (2Y, 3Y,5Y) the formula should be =1*RC[-5]. this condition is only applicable on RUZ ccy, for the rest, one formula per ccy(currency) will be used for all their respective tenors.
the formula is placed in column P,
tenors are placed in column B
Sub Get_vpl()
' Define Constants.
Const wsName As String = "DS"
Const FirstRow As Long = 5
Const srcCol As String = "A"
Const tgtCol As String = "P"
Dim Criteria As Variant
Dim Formulas As Variant
Criteria = Array("RUB", "TRY", "TWD", "UAH", "UYU", "VND") ' add more...
Formulas = Array( "=1/(1/R208C[-5]+RC12/10000)", "=1*RC[-5]", "=1/(1/R232C[-5]+RC12/1)", "=1*RC[-5]", "=1*RC[-5]", "=1*RC[-5]") ' add more...
' Define the Source Column Range.
' Define workbook.
Dim wb As Workbook
Set wb = ThisWorkbook
' Define worksheet.
Dim ws As Worksheet
Set ws = wb.Worksheets(wsName)
' Calculate Last Non-Empty Row.
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, srcCol).End(xlUp).Row
' Define Source Column Range.
Dim rng As Range
Set rng = ws.Range(ws.Cells(FirstRow, srcCol), ws.Cells(LastRow, srcCol))
' Prepare to write to Target Column Range.
' Calculate Column Offset.
Dim ColOffset As Long
ColOffset = ws.Columns(tgtCol).Column - ws.Columns(srcCol).Column
' Declare variables.
Dim CurPos As Variant ' Current Position
Dim cel As Range ' Current Cell Range
' Write formulas to Target Column Range.
Application.ScreenUpdating = False
' Iterate the cell ranges in Source Range.
For Each cel In rng.Cells
' Check if Current Cell Range in Source Column Range is not empty.
If Not IsEmpty(cel) Then
' Try to find the value in Current Cell Range in Criteria Array
' and write the position to Current Position
CurPos = Application.Match(cel, Criteria, 0)
' Check if value in Current Cell Range has been found
' in Criteria Array.
If Not IsError(CurPos) Then
' Write formula from Formulas Array to current Target Cell
' Range, using Current Position in Criteria Array.
cel.Offset(, ColOffset).Formula = _
Application.Index(Formulas, CurPos)
End If
End If
Next cel
Application.ScreenUpdating = True
End Sub

Answer 1

I have done more than intended to your code because I had so much difficulty understanding what you need. However, I'm rather pleased with the result and hope you will be, too. Note that I never ran the code and it may, therefore, contain minor bugs or typos which I shall be happy to rectify if you point them out.
Option Explicit
Enum Nws ' worksheet navigation
NwsFirstRow = 5
NwsCcy = 1 ' Columns: A = Currency
NwsTenor ' B = Tenor
NwsTarget = 16 ' P = Target
End Enum
Sub Get_vpl()
' 116
' Define Constants.
Const wsName As String = "DS"
' Declare variables.
Dim Wb As Workbook
Dim Ws As Worksheet
Dim CcyIdx As Integer ' return value from CurrencyIndex()
Dim R As Long ' loop counter: rows
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets(wsName)
Application.ScreenUpdating = False
With Ws
' this syntax is easier because you need the row number R
For R = NwsFirstRow To .Cells(.Rows.Count, NwsCcy).End(xlUp).Row
CcyIdx = CurrencyIndex(.Cells(R, NwsCcy).Value)
If CcyIdx >= 0 Then
.Cells(R, NwsTarget).Formula = ChooseFormula(CcyIdx, .Cells(R, NwsTenor).Value)
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
Private Function ChooseFormula(ByVal CcyIdx As Integer, _
ByVal Tenor As String) As String
' 116
' return the formula specified by Idx or Formula(0)
Dim Idx As Integer
Dim Formula(2) As String
' the advantage of the syntax you chose is that the array
' is dimensioned automatically.
' Here the advantage is clarity.
Formula(0) = "=1*RC[-5]"
Formula(1) = "=1/(1/R208C[-5]+RC12/10000)"
Formula(2) = "=1/(1/R232C[-5]+RC12/1)"
If CcyIdx = 0 Then
If InStr("1Y,2Y,3Y,5Y", Tenor) Then Idx = 1
End If
ChooseFormula = Formula(Idx)
End Function
Private Function CurrencyIndex(ByVal Currcy As String) As Integer
' 116
' return -1 if not found or blank
Dim Ccy() As String ' list of currencies
Dim i As Integer
' I added "RUZ" in position 0 (change to suit and match in ChooseFormula())
' this syntax uses less space but doesn't support MATCH()
Ccy = Split("RUZ RUB TRY TWD UAH UYU VND") ' add more...
If Len(Trim(Currcy)) Then
For i = UBound(Ccy) To 0 Step -1
If StrComp(Currcy, Ccy(i), vbTextCompare) = 0 Then Exit For
Next i
Else
i = -1
End If
CurrencyIndex = i
End Function
I found your Criteria rather useless in this context. Perhaps that's why I gave it a task. The function CurrencyIndex() returns the index number of the current currency and uses this number thereafter in place of the actual currency code. For this purpose I added "RUZ" to your array. I have it in first position but any other number will do as well.
Please look at the function ChooseFormula(). It seems you have only 3 formulas. I assigned the index 0 to the most common one and made that the default. For the rest of it, the CcyIdx is passed to the function as an argument and if that index = 0 it identifies "RUZ" and gives it special treatment. I'm not sure that the treatment I assigned is 100% correct or workable but I think the code is simple and you should be able to modify it as required. Observe that the function won't ever return Formula(2) in its present state but you can modify it easily to accommodate all kinds of conditions and many more possible formulas. Let me know if you need any help with that.