我的InputBox未被评估...代码运行，但是代码似乎在其上跳转

Question

我的代码似乎可以编译并正确运行，但是由于某些原因，似乎根本没有对Inputbox进行评估。 Inputbox位于代码的中间，我要完成的工作是针对MonthName评估单元数据，如果匹配，则向用户吐出一个Inputbox。它正在评估的功能是：

 =IFERROR(VLOOKUP($A3,'G:\Financial\Facility Work Papers and Financials\1. 
 Operating Entities\Arbors\2. Financials\2018\5. May\[Arbors May 2018.xls]Trial 
 Balance'!$A$30:$H$100,8,FALSE),0)

代码如下：

Sub Date1()

    Dim r As Range
    Dim s As String
    Dim UserInput As String
    Dim Curdate As Date
    Dim newDate As String
    Dim newDate1 As String
    Dim newDate2 As String
    Dim newDate3 As String
    Dim LastCol As Integer
    Dim LastRow As Integer
    Dim j As Integer
    Dim i As Integer
    Dim k As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    With ActiveSheet
        For k = 1 To 12
            Curdate = CDate(k & " " & "01," & " " & "2018")

            newDate1 = MonthName(Month(Curdate), False)
            newDate2 = MonthName(Month(Curdate), True)
            newDate3 = Month(Curdate)
            newDate = newDate3 & "." & newDate2

            Debug.Print newDate
            Debug.Print newDate1
            'Defining the loops parameteres

            For Each r In ActiveSheet.Range("D3:D6").Cells.SpecialCells(xlCellTypeFormulas)
                s = LCase(r.Formula)
                If InStr(1, r, newDate1) > 0 Then

                    UserInput = Application.InputBox(prompt:=newDate1 & "is the current data, if this is the data you want", Title:="please click cancel, otherwise click OK", Default:=newDate1)

                End If
            Next r
        Next k

        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        For i = 1 To LastCol
            For j = 1 To LastRow
                With ActiveWorkbook.Sheets("Data")

                    .Range(.Cells(j, 1), .Cells(1, i)).Replace What:=oldDate3 & "." & " " & oldDate2, replacement:=newDate, LookAt:=xlPart, MatchCase:=False
                    .Range(.Cells(j, 1), .Cells(1, i)).Replace What:=oldDate1, replacement:=newDate1, LookAt:=xlPart, MatchCase:=False

                End With
            Next j
        Next i
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Debug.Print Curdate
    Debug.Print newDate3 & "." & newDate2
    Debug.Print newDate1
    Debug.Print newDate

End Sub