Userform with drop down box displaying Date in incorrect format

**sgreni** · 06-24-2009, 03:36 PM

All,

I have a userform with a dropdown box allowing the user to select from a range of dates. The dates are on a sheet with in the workbook and I have created a "Name" range for the range of dates. The userform then uses this name as the rowsource. These dates are generated using "=today()+x" where x is actually a number ranging from 1 to 28, i.e., tomorrow to 4 weeks from today. Anyways, the drop down box allows the user to select from these range of dates with a format mm/dd/yyyy, however when a date is selected it converts to the numerical value of the date. Below is my code from the userform.

Private Sub cmdCancel_Click()
    
    Unload Me
    
End Sub

Private Sub cmdClear_Click()

    Me.cboRequestDate.Value = ""
        
    Me.cboAuthor.Value = ""
        
    Me.ckbCost.Value = ""
    
    Me.ckbImpact.Value = ""
    
    Me.txtSubject.Value = ""
    
    Me.txtQuestion.Value = ""
    
    Me.txtPropSol.Value = ""
    
    Me.txtConLoc.Value = ""
    
    Me.txtAddCom.Value = ""
    
End Sub


Private Sub cmdOK_Click()
    
    'When a user clicks the "OK" button this routine allows the user to
    
    If Format(Me.cboRequestDate.Value, mm / dd / yyyy = "") Then
        MsgBox "Please select a Response Date.", vbExclamation, "Requested Response Date"
        Me.cboRequestDate.SetFocus
        Exit Sub
    End If
        
    If Me.cboAuthor.Value = "" Then
        MsgBox "The Author of this RFI must be selected!", vbExclamation, "Author"
        Me.cboAuthor.SetFocus
        Exit Sub
    End If
     
    If Me.txtSubject.Value = "" Then
        MsgBox "Please enter the Subject of the RFI.", vbExclamation, "Subject"
        Me.txtSubject.SetFocus
        Exit Sub
    End If
    
    If Me.txtQuestion.Value = "" Then
        MsgBox "Please enter the Question of your RFI", vbExclamation, "Question"
        Me.txtQuestion.SetFocus
        Exit Sub
    End If
    
    If Me.txtPropSol.Value = "" Then
        MsgBox "Please enter your Proposed Solution to the Problem at hand.", vbExclamation, "Proposed Solution"
        Me.txtPropSol.SetFocus
        Exit Sub
    End If
    
    If Me.txtConLoc.Value = "" Then
        MsgBox "Please enter the location of the problem addressed in the RFI.", vbExclamation, "Conflict Location"
        Me.txtConLoc.SetFocus
        Exit Sub
    End If
    
    If Me.txtAddCom.Value = "" Then
        MsgBox "Please enter any Comments; if none exist, enter NONE.", vbExclamation, "Additional Comments"
        Me.txtAddCom.SetFocus
        Exit Sub
    End If
         
    Sheets("RequestForInformation").Activate
    Range("p17").Select
        ActiveCell.Value = Me.cboAuthor.Value
        
    Range("p18").Select
        ActiveCell.Value = Me.cboRequestDate.Value
        
    If Me.ckbCost.Value = True Then
        Range("H20").Select
        Selection.Interior.ColorIndex = 1
    Else
        Range("j20").Select
        Selection.Interior.ColorIndex = 1
    End If
    
    If Me.ckbImpact.Value = True Then
        Range("h22").Select
        Selection.Interior.ColorIndex = 1
    Else
        Range("j22").Select
        Selection.Interior.ColorIndex = 1
    End If
    
    Range("d26:p26").Select
        ActiveCell.Value = Me.txtSubject.Value
    
    Range("d32:p43").Select
        ActiveCell.Value = Me.txtQuestion.Value
        
    Range("d46:p48").Select
        ActiveCell.Value = Me.txtPropSol.Value
    
    Range("d51:p56").Select
        ActiveCell.Value = Me.txtConLoc.Value
    
    Range("d61:p63").Select
        ActiveCell.Value = Me.txtAddCom.Value
    Sheets("Title Page").Activate
    
    'Resets form after entry has been made
        
    Me.cboRequestDate.Value = ""
        
    Me.cboAuthor.Value = ""
        
    Me.ckbCost.Value = ""
    
    Me.ckbImpact.Value = ""
    
    Me.txtSubject.Value = ""
    
    Me.txtQuestion.Value = ""
    
    Me.txtPropSol.Value = ""
    
    Me.txtConLoc.Value = ""
    
    Me.txtAddCom.Value = ""
   
End Sub