Do Until loop in VBA does not break on Exit Sub - vba

Question

I wrote the following code in order to ask for an input.
validInput = False
Do
str = InputBox("Some text...")
If str = vbNullString Then
MsgBox ("Input canceled")
Exit Sub
Else
If IsNumeric(str) Then
exchange = CCur(str)
validInput = True
Else
MsgBox ("Input invalid.")
End If
End If
Loop Until validInput
However, if I cancel my input it keeps asking me for an input and the loop goes on even though I added the Exit Sub line.
I tried to add validInput = True before Exit Sub but that didn't work either.
What am I missing?
EDIT:
Here is the whole sub.
Public Sub CurrencyCheck()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Datenbank")
Dim lastRow As Long
lastRow = ws.Cells(Rows.Count, 4).End(xlUp).Row
Dim i As Long
Dim j As Long
Dim curSymbol As String
Dim exchange As Currency
Dim str As String
Dim curArr() As String
Dim arrCnt As Integer
arrCnt = 1
Dim curInArr As Boolean
curInArr = False
Dim curIndex As Integer
Dim validInput As Boolean
ReDim curArr(1 To 2, 1 To arrCnt)
For i = 1 To lastRow
If ws.Cells(i, 4).Value <> "Price" And ws.Cells(i, 4).Value <> "" Then
curSymbol = Get_Currency(ws.Cells(i, 4).text) 'Function that returns currency symbol (€) or abbreviation (EUR)
If curSymbol <> "€" Then
For j = LBound(curArr, 2) To UBound(curArr, 2)
If curArr(1, j) = curSymbol Then
curInArr = True
curIndex = j
End If
Next j
If Not curInArr Then
If curSymbol = "EUR" Then
ReDim Preserve curArr(1 To 2, 1 To arrCnt)
curArr(1, arrCnt) = curSymbol
curArr(2, arrCnt) = 1
curIndex = arrCnt
arrCnt = arrCnt + 1
Else
validInput = False
Do Until validInput
str = InputBox("Some text...")
If str = vbNullString Then
MsgBox ("Input canceled.")
Exit Sub
Else
If IsNumeric(str) Then
exchange = CCur(str)
validInput = True
Else
MsgBox ("Input invalid.")
End If
End If
Loop
ReDim Preserve curArr(1 To 2, 1 To arrCnt)
curArr(1, arrCnt) = curSymbol
curArr(2, arrCnt) = exchange
curIndex = arrCnt
arrCnt = arrCnt + 1
End If
End If
ws.Cells(i, 4).Value = StringToCurrency(ws.Cells(i, 4).text)
ws.Cells(i, 4).Value = ws.Cells(i, 4).Value * curArr(2, curIndex)
ws.Cells(i, 4).NumberFormat = "#,##0.00 €"
End If
End If
Next i
End Sub
EDIT2: When I run the input loop as a subroutine by itself it works. The macro is run in another workbook and doing that it fails...
EDIT3: My bad. The problem is not related to the code but to the positioning of the subroutine. It was called of and over again because it was called in a loop. I have to apologize. Thanks to everyone.

Answer 1

This will loop until a numeric is entered:
Sub dural()
Dim validInput As Boolean
Dim strg As String, x As Variant
validInput = False
Do
strg = Application.InputBox(Prompt:="enter value", Type:=2)
If strg = "False" Then
ElseIf IsNumeric(strg) Then
x = CCur(strg)
validInput = True
End If
Loop Until validInput
End Sub
EDIT#1:
This version will quit the loop if the user touches the CANCEL button or the red x button:
Sub dural()
Dim validInput As Boolean
Dim strg As String, x As Variant
validInput = False
Do
strg = Application.InputBox(Prompt:="enter value", Type:=2)
If strg = "False" Or strg = "" Then
validInput = True
ElseIf IsNumeric(strg) Then
x = CCur(strg)
validInput = True
End If
Loop Until validInput
End Sub

Answer 2

I don't think is a null string. Try this
If str = vbNullString or str = "" Then