Hi

I know this is a common problem. but i have tried solutions and they haven't worked for me or I havent been able to use them effectively.

My problem is that I have a userform which enters data into excel, it has the option to search and update the data.

When it comes to either entering new data or loading previously entered data, my data comes in american format "mm/dd/yyyy" but I need it to be in uk format "dd/mm/yyyy".

Dim ws As Worksheet
Dim MyData As Range
Dim c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
Const frmMax As Long = 500
Const frmHt As Long = 450
Const frmWidth As Long = 300
Dim oCtrl As MSForms.Control



Private Sub cmbAdd_Click()
     'next empty cell in column A
     
     
    Set c = MyData.Cells(MyData.Rows.Count, 1).Offset(1)
     
      If ComboColour.Text = Empty Then
        MsgBox "Please select a colour.", vbExclamation
        Me.ComboColour.SetFocus
        Exit Sub
    End If
        
      If Not IsDate(txtDate) Then
        MsgBox "Input must be a date in the format: 'dd/mm/yyyy'"
        'Cancel = True
        Exit Sub
    Else
        txtDate = Format(txtDate, "dd/mm/yyyy")
    End If
     
    Application.ScreenUpdating = False 'speed up, hide task
     'write userform entries to database
    With Me
        c.Value = .txtBody.Value
        c.Offset(0, 1).Value = .txtDate.Value
        c.Offset(0, 2).Value = .ComboColour.Value
        c.Offset(0, 3).Value = .txtTech.Value
        c.Offset(0, 4).Value = .txtSent.Value
        c.Offset(0, 5).Value = .txtRet.Value
        c.Offset(0, 6).Value = .txtinbox.Value
        c.Offset(0, 7).Value = .txtTimestamp.Value
         'clear the form
        ClearControls
         'resize database
        Set MyData = c.CurrentRegion
        Me.ScrollBar1.Max = MyData.Rows.Count
    End With
    Application.ScreenUpdating = True
    
      xxx = Split(txtDate.Value, "/")
'ActiveCell.Offset(0, 2) = DateSerial(xxx(2), xxx(1), xxx(0))
    txtTimestamp.Value = Now
    txtTimestamp = Format(txtTimestamp.Value, "dd mmmm yyyy hh:mm")
    
End Sub
 
 
Private Sub cmbDelete_Click()
    Dim msgResponse As String 'confirm delete
    Application.ScreenUpdating = False
     'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
    vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse 'action dependent on response
    Case vbYes
         'c has been selected by Find button
        c.EntireRow.Delete 'remove entry by deleting row
        Set MyData = ws.Range("a2").CurrentRegion 'database
         'restore form settings
        With Me
            .cmbAmend.Enabled = False 'prevent accidental use
            .cmbDelete.Enabled = False 'prevent accidental use
            .cmbAdd.Enabled = True 'restore use
            .ScrollBar1.Max = MyData.Rows.Count
             'clear form
            ClearControls
        End With
         
         
    Case vbNo
        Exit Sub 'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub
 
 
Private Sub cmbFind_Click()
    Dim strFind As String 'what to find
    Dim FirstAddress As String
    Dim f As Integer
     
     
     '    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.txtBody.Value 'what to look for
     
     
    With MyData
        .AutoFilter
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then 'found it
             
             
            With Me 'load entry to form
                .txtDate.Value = c.Offset(0, 1).Value
                .ComboColour.Value = c.Offset(0, 2).Value
                .txtTech.Value = c.Offset(0, 3).Value
                .txtSent.Value = c.Offset(0, 4).Value
                .txtRet.Value = c.Offset(0, 5).Value
                .txtinbox.Value = c.Offset(0, 6).Value
                .txtTimestamp.Value = c.Offset(0, 7).Value
                .cmbAmend.Enabled = True 'allow amendment or
                .cmbDelete.Enabled = True 'allow record deletion
                .cmbAdd.Enabled = False 'don't want to duplicate record
                 
                r = c.Row
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1 'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
                     
                     
                Case vbOK
                    FindAll
                Case vbCancel
                     'do nothing
                End Select
                Me.Height = frmMax
                 
                 
            End If
        Else: MsgBox strFind & " not listed" 'search failed
        End If
    End With
     
     
End Sub
 
 
Private Sub cmbAmend_Click()
    Application.ScreenUpdating = False
    If r <= 0 Then Exit Sub
     
     
    Set c = ws.Cells(r, 1)
    c.Value = Me.txtBody.Value ' write amendments to database
    c.Offset(0, 1).Value = Me.txtDate.Value
    c.Offset(0, 2).Value = Me.ComboColour.Value
    c.Offset(0, 3).Value = Me.txtTech.Value
    c.Offset(0, 4).Value = Me.txtSent.Value
    c.Offset(0, 5).Value = Me.txtRet.Value
    c.Offset(0, 6).Value = Me.txtinbox.Value
    c.Offset(0, 7).Value = Me.txtTimestamp.Value
     'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
       ' ClearControls
        .Height = frmHt
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A2").AutoFilter
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub
Sub FindAll()
    Dim wesTemp As Worksheet
    Dim strFind As String 'what to find
     
     
    strFind = Me.txtBody.Value
     
     
    If Not ws.AutoFilterMode Then MyData.AutoFilter
     
     
    MyData.AutoFilter Field:=1, Criteria1:=strFind
     
     
    Me.ListBox1.Clear
    For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
        With ListBox1
            .AddItem c.Value
            .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
            .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
            .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
            .List(.ListCount - 1, 5) = c.Offset(0, 5).Value
            .List(.ListCount - 1, 6) = c.Offset(0, 6).Value
            .List(.ListCount - 1, 7) = c.Offset(0, 7).Value
            .List(.ListCount - 1, 8) = c.Row
        End With
    Next c
     
     
End Sub


Private Sub cmdClear_click()
        Me.txtDate.Value = ""
        Me.ComboColour.Value = ""
        Me.txtTech.Value = ""
        Me.txtSent.Value = ""
        Me.txtRet.Value = ""
        Me.txtinbox.Value = ""
        Me.txtTimestamp.Value = ""
End Sub

Private Sub ListBox1_Click()
     
     
    With Me.ListBox1
         
         
        If .ListIndex = -1 Then 'not selected
            MsgBox " No selection made"
        ElseIf .ListIndex >= 1 Then 'User has selected
            r = Val(.List(.ListIndex, .ColumnCount - 1))
        End If
    End With
     
     
    With Me
        .txtBody.Value = .ListBox1.List(.ListBox1.ListIndex, 0)
        .txtDate.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
        .ComboColour.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
        .txtTech.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
        .txtSent.Value = .ListBox1.List(.ListBox1.ListIndex, 4)
        .txtRet.Value = .ListBox1.List(.ListBox1.ListIndex, 5)
        .txtinbox.Value = .ListBox1.List(.ListBox1.ListIndex, 6)
        .txtTimestamp.Value = .ListBox1.List(.ListBox1.ListIndex, 7)
        .cmbAmend.Enabled = True 'allow amendment or
        .cmbDelete.Enabled = True 'allow record deletion
        .cmbAdd.Enabled = False 'don't want duplicate
    End With
     
     
End Sub
 
 
Private Sub ScrollBar1_Change()
    Dim Rw As Long
    Rw = Me.ScrollBar1.Value
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .txtBody.Value = MyData.Cells(Rw, 1).Value
        .txtDate.Value = MyData.Cells(Rw, 2).Value
        .ComboColour.Value = MyData.Cells(Rw, 3).Value
        .txtTech.Value = MyData.Cells(Rw, 4).Value
        .txtSent.Value = MyData.Cells(Rw, 5).Value
        .txtRet.Value = MyData.Cells(Rw, 6).Value
        .txtinbox.Value = MyData.Cells(Rw, 7).Value
        .txtTimestamp.Value = MyData.Cells(Rw, 8).Value
         
    End With
     
     
End Sub
 

Private Sub txtRet_Change()
   If txtSent.Value = "" Then Exit Sub
         If txtRet.Value = "" Then Exit Sub
      txtinbox.Value = Val(txtSent.Value) - Val(txtRet.Value)
   ' OnlyNumbers
End Sub


 

Private Sub txtret_exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Not IsNumeric(Me.txtRet.Value) Then
    MsgBox "Please enter only numeric values!"
    If Not IsNumeric(Me.txtRet.Value) Then
    Me.txtRet.Value = ""
    Cancel = True
    End If
    End If
End Sub


Private Sub ComboColour_Change()
        Me.txtSent.Value = Sheet3.Cells(Me.ComboColour.ListIndex + 2, 2).Value
        Me.txtTech.Value = Sheet3.Cells(Me.ComboColour.ListIndex + 2, 3).Value
End Sub
 Private Sub txtDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
 ddate = DateSerial(year(Date), Month(Date), Day(Date))
    txtDate.Value = Format(txtDate.Value, "dd/mm/yyyy")
    ddate = txtDate.Value
End Sub
 Private Sub txtSent_Change()
  If txtSent.Value = "" Then Exit Sub
     If txtRet.Value = "" Then Exit Sub
        txtinbox.Value = Val(txtSent.Value) - Val(txtRet.Value)
      '  OnlyNumbers
End Sub
Private Sub OnlyNumbers()
    With Me.ActiveControl
        If TypeName(Me.ActiveControl) = "txtRet" Then
            If Not IsNumeric(.Value) And .Value <> vbNullString Then
             MsgBox "Only numbers allowed"
                .Value = vbNullString
                .SetFocus
            End If
        End If
    End With
End Sub
 Private Sub UserForm_Initialize()
    With Me
        .Caption = "Basecoat Log" 'userform caption
        .Height = frmHt
        .Width = frmWidth
        .ScrollBar1.Min = 2
        Set ws = Worksheets("MasterColour")
        .ComboColour.List = ws.Range("ColourList").Value
        .txtTimestamp.Value = Format(Now, "dd mmmm yyyy hh:mm")
        .txtBody.SetFocus
         'change sheet name and Range here
        Set ws = Sheet1
        Set MyData = ws.Range("a2").CurrentRegion 'database
        .ScrollBar1.Max = MyData.Rows.Count
    End With
End Sub
Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
            Case "TextBox": oCtrl.Value = Empty
            End Select
        Next oCtrl
    End With
End Sub