Input Box avoid blank entries

user_12928416 0
Viewed 36

the vba copies data from the "source" to the "final" tab based on a date entered by the user the source has been reformatted (columns removed and added etc) in an "export" tab prior being copied in to the "final" tab. the vba below works but, I want to tighten the process and avoid the user from simply clicking on ok or cancel as this results in all data from the source spreadsheet being copied

 Public Sub Copydata()

  Dim CopySheet As Worksheet
  Dim PasteSheet As Worksheet
  Dim FinalSheet As Worksheet
  Dim nextRow As Long
  Dim FinalRow As Long
  Dim lastRow As Long
  Dim thisRow As Long
  Dim myValue As Date
  Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
         
  ws.Name = "Export"
  ' Get the sheet references
  Set CopySheet = Sheets("Source")
  Set PasteSheet = Sheets("Export")
  Set FinalSheet = Sheets("Final")


  lastRow = CopySheet.Cells(CopySheet.Rows.Count, "B").End(xlUp).Row
  nextRow = PasteSheet.Cells(PasteSheet.Rows.Count, "A").End(xlUp).Row + 1

  myValue = InputBox("Enter start date to transfer", "Input Date")

 For thisRow = 1 To lastRow
     
 If CopySheet.Cells(thisRow, "B").Value >= myValue Then
 
    CopySheet.Cells(thisRow, "B").EntireRow.Copy Destination:=PasteSheet.Cells(nextRow, "A")
    
    
  nextRow = nextRow + 1
  End If
  Next thisRow""

I had thought about a loop until the date was entered something like:

    Do
    myValue = InputBox("Enter start date to transfer", "Input Date")

    If myValue = "" Then
    MsgBox "You must enter a date as dd/mm/yyyy", vbOKOnly, "Invalid Date"
    Else
    Exit Do
    End If
    Loop

But it just loops even if a date is entered and doesn't carry on with the code or errors with a type mismatch.

Any guidance would be appreciated thank you

copy vba excel loops
2 Answers

Check if the user pressed cancel using If VarType(RetVal) = vbBoolean And RetVal = False Then if cancel is pressed the return type is False boolean. This way the user is able to press cancel if he wants to stop proceeding.

Further I recommend to validate the input date against dd/mm/yyyy as I did below.

Option Explicit

Public Sub Example()
    Do
        Dim RetVal As Variant
        RetVal = Application.InputBox("Enter start date to transfer", "Input Date", Type:=2)
        
        If VarType(RetVal) = vbBoolean And RetVal = False Then
            ' user pressed cancel
            Exit Sub
        End If
        
        If RetVal = vbNullString Or Not IsValidDate(RetVal) Then
            MsgBox "You must enter a date as dd/mm/yyyy", vbOKOnly + vbExclamation, "Invalid Date"
        Else
            Exit Do
        End If
    Loop
    
    ' input date as numeric date instead of string
    Dim NumericDateFromInput As Date
    NumericDateFromInput = GetNumericDateFromStringDDMMYYYY(InputVal)
End Sub


' returns true if the input string is a valid date of the format dd/mm/yyyy
Public Function IsValidDate(ByVal InputVal As String) As Boolean
    IsValidDate = Not (InputVal = 0)
End Function


' returns a numeric date if the input string is of the format dd/mm/yyyy
Public Function GetNumericDateFromStringDDMMYYYY(ByVal InputVal As String) As Date
    Dim Parts() As String
    Parts = Split(InputVal, "/")
    
    If UBound(Parts) <> 2 Then Exit Function
    
    Dim NumericDate As Date
    On Error Resume Next
    NumericDate = DateSerial(Parts(2), Parts(1), Parts(0))
    On Error GoTo 0
    
    If InputVal = Format$(GetNumericDateFromStringDDMMYYYY(InputVal), "dd\/mm\/yyyy") Then
        GetNumericDateFromStringDDMMYYYY = NumericDate
    End If
End Function

Note that re-checking the numeric date against the formatted Format$ date is to ensure the format is entered as 14/07/2021 and not 14/7/2021 but as well as the entered date exists! Because if you don't do that then entering an invalid date like 32/07/2021 will be tuned by DateSerial() into 01/08/2021 and then you have a wrong date that is not what the user entered and what the usered entered was no valid date.

user_32196130

Perhaps this works for you? One issue is that you declare myValue as Date so if a date is then not entered you will get a mismatch.

Sub x()

Dim myValue As Variant

Do
    myValue = Application.InputBox("Enter start date to transfer", "Input Date")
    If myValue = False Then Exit Sub 'cancel
    If IsDate(myValue) Then
        Exit Do
    Else
        MsgBox "You must enter a date as dd/mm/yyyy", vbOKOnly, "Invalid Date"
    End If
Loop

End Sub
user_70080440
Related