VBA Date Match Error

[TIFinance]

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

[SamT]

I can't see where the custom Date "myValue" even comes into play in the sub. I even refactored it to read my way.

Sub GetReturnsCustomDate()
Dim myValue As Variant
Dim ColNum As Long
Dim c As Long
Dim TmpRng As Range
Dim Cel As Range
Dim i As Variant, j As Integer

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

  myValue = InputBox("Enter Custom Date", "Custom Date", "MM/DD/YYYY")
  With Worksheets("Admin")
    .Range("E1").Value = myValue
    i = .Range("E2").Value
    j = .Range("F2").Value
  End With
  
  With Worksheets("DMS")
    ColNum = .Range("A2").Value
    Set TmpRng = Range(.Cells(j, 2), .Cells(j, ColNum))
    For c = 2 To ColNum
      If (.Cells(4, c) <> "N/A" And .Cells(7, c) = "BDPHeader") _
        Or (.Cells(4, c) <> "N/A" And .Cells(7, c) = "BDPHeaderALT") _
        And (.Cells(4, c) <> "LBUSTRUU" _
            Or .Cells(4, c) <> "LF98TRUU" _
            Or .Cells(4, c) <> "BXIIUN10" _
            Or .Cells(4, c) <> "BCIT1T" _
            Or .Cells(4, c) <> "LB15TRUU") _
      Then
       TmpRng.Cells(c).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 c
    
    .Range("B1").Select
  End With

Application.Calculation = xlCalculationAutomatic
Application.OnTime Now + TimeValue("00:00:20"), "PasteReturns"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

You might try rearranging the order of these lines

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.OnTime Now + TimeValue("00:00:20"), "PasteReturns"
Application.ScreenUpdating = True

Or subsituting DoEvents thusly

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
DoEvents
PasteReturns
Application.ScreenUpdating = True