TIFinance
12-30-2014, 11:03 AM
I'm trying to build a function to find the returns for a specific date that the user enters (as prompted by the macro). So far, the macro gets accurate returns but I have to enter the date and run the macro twice to get the returns for the date I want. When I enter a date, the macro calculates the returns for whatever custom date I entered previously. How do I change my macro to calculate returns for the date I enter the first time around?
Code is as follows:
Sub GetReturnsCustomDate()
Dim myValue As Variant
Dim RowNum As Long
Dim ColNum As Integer
Dim TmpRng As Range
Dim Rng As Range
Dim NewDate As Integer
Dim i, j As Integer
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("DMS").Activate
ColNum = Range("A2").Value
myValue = InputBox("Enter Custom Date", "Custom Date", "MM/DD/YYYY")
Worksheets("Admin").Activate
Range("E1").Value = myValue
i = Cells(2, 5).Value
j = Cells(2, 6).Value
Worksheets("DMS").Activate
Set TmpRng = Range(Cells(j, 2), Cells(j, ColNum))
For Each Rng In TmpRng
If (Cells(4, Rng.Column) <> "N/A" And Cells(7, Rng.Column) = "BDPHeader") Or (Cells(4, Rng.Column) <> "N/A" And Cells(7, Rng.Column) = "BDPHeaderALT") And (Cells(4, Rng.Column) <> "LBUSTRUU" Or Cells(4, Rng.Column) <> "LF98TRUU" Or Cells(4, Rng.Column) <> "BXIIUN10" Or Cells(4, Rng.Column) <> "BCIT1T" Or Cells(4, Rng.Column) <> "LB15TRUU") Then
Rng.FormulaR1C1 = "=IF(AND(COUNT(R13C:R" & [j] - 1 & "C)<>0,BDP(R5C,R6C,Indirect(R7C),Offset(BDPHeader," & [i] & ",0))=""#N/A N/A""),"""",IF(AND(COUNT(R13C:R" & [j] - 1 & "C)=0,BDP(R5C,R6C,Indirect(R7C),Offset(BDPHeader," & [i] & ",0))=""#N/A N/A""),"""",BDP(R5C,R6C,Indirect(R7C),Offset(BDPHeader," & [i] & ",0))))"
End If
Next Rng
Application.Calculation = xlCalculationAutomatic
Application.OnTime Now + TimeValue("00:00:20"), "PasteReturns"
Worksheets("DMS").Activate
Worksheets("DMS").Range("B1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Code is as follows:
Sub GetReturnsCustomDate()
Dim myValue As Variant
Dim RowNum As Long
Dim ColNum As Integer
Dim TmpRng As Range
Dim Rng As Range
Dim NewDate As Integer
Dim i, j As Integer
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("DMS").Activate
ColNum = Range("A2").Value
myValue = InputBox("Enter Custom Date", "Custom Date", "MM/DD/YYYY")
Worksheets("Admin").Activate
Range("E1").Value = myValue
i = Cells(2, 5).Value
j = Cells(2, 6).Value
Worksheets("DMS").Activate
Set TmpRng = Range(Cells(j, 2), Cells(j, ColNum))
For Each Rng In TmpRng
If (Cells(4, Rng.Column) <> "N/A" And Cells(7, Rng.Column) = "BDPHeader") Or (Cells(4, Rng.Column) <> "N/A" And Cells(7, Rng.Column) = "BDPHeaderALT") And (Cells(4, Rng.Column) <> "LBUSTRUU" Or Cells(4, Rng.Column) <> "LF98TRUU" Or Cells(4, Rng.Column) <> "BXIIUN10" Or Cells(4, Rng.Column) <> "BCIT1T" Or Cells(4, Rng.Column) <> "LB15TRUU") Then
Rng.FormulaR1C1 = "=IF(AND(COUNT(R13C:R" & [j] - 1 & "C)<>0,BDP(R5C,R6C,Indirect(R7C),Offset(BDPHeader," & [i] & ",0))=""#N/A N/A""),"""",IF(AND(COUNT(R13C:R" & [j] - 1 & "C)=0,BDP(R5C,R6C,Indirect(R7C),Offset(BDPHeader," & [i] & ",0))=""#N/A N/A""),"""",BDP(R5C,R6C,Indirect(R7C),Offset(BDPHeader," & [i] & ",0))))"
End If
Next Rng
Application.Calculation = xlCalculationAutomatic
Application.OnTime Now + TimeValue("00:00:20"), "PasteReturns"
Worksheets("DMS").Activate
Worksheets("DMS").Range("B1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub