I'm getting a date problem when the user inputs 03/01/1900 (d/m/y), as the entry goes in as 01/03/1900. If you "cheat" and put the date as 01/03/1900 to get the desired result of 03/01/1900, it goes in okay.
Private Sub cmbEnter_Click()
' Input known soldier's number and enlistment date to add to selected Regiment / Battalion
Dim LastRow As Integer, LastCol As Integer, Cnt As Integer, Cnt2 As Integer
Dim Sht As Worksheet, SortRange As Range
If frmEnlistment.lboRegiment.ListIndex = -1 Then
MsgBox "Select Regiment!", vbExclamation + vbOKOnly, "Soldier Enlistment"
Exit Sub
End If
If frmEnlistment.lboBattalion.ListIndex = -1 Then
MsgBox "Select Battalion!", vbExclamation + vbOKOnly, "Soldier Enlistment"
Exit Sub
End If
If Not IsNumeric(frmEnlistment.txtSoldierNumber.Value) Or _
frmEnlistment.txtSoldierNumber.Text = vbNullString Then
MsgBox "Enter Soldier Number!", vbExclamation + vbOKOnly, "Soldier Enlistment"
Exit Sub
End If
If Not IsDate(frmEnlistment.txtEnlistmentDate.Text) Or _
frmEnlistment.txtEnlistmentDate.Text = vbNullString Then
MsgBox "Enter date in Day-Month-Year format!", vbExclamation + vbOKOnly, "Soldier Enlistment"
Exit Sub
End If
For Each Sht In ThisWorkbook.Sheets
If frmEnlistment.lboRegiment.List(frmEnlistment.lboRegiment.ListIndex) = Sht.Name Then
With Sheets(Sht.Name)
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Cnt = 1 To LastCol
If Sheets(Sht.Name).Cells(1, Cnt) = frmEnlistment.lboBattalion.List(frmEnlistment.lboBattalion.ListIndex) Then
LastRow = .Cells(.Rows.Count, Cnt).End(xlUp).Row
For Cnt2 = 3 To LastRow
If CInt(Sheets(Sht.Name).Cells(Cnt2, Cnt)) = CInt(frmEnlistment.txtSoldierNumber.Value) Then
frmEnlistment.txtEnlistmentDate.Text = vbNullString
MsgBox "Soldier number already exists!", vbExclamation + vbOKOnly, "Soldier Enlistment"
frmEnlistment.txtEnlistmentDate.Text = Format(Sheets(Sht.Name).Cells(Cnt2, Cnt + 1), "dd/mm/yyyy")
Exit Sub
End If
Next Cnt2
.Cells(LastRow + 1, Cnt) = frmEnlistment.txtSoldierNumber.Value
.Cells(LastRow + 1, Cnt + 1) = Format(frmEnlistment.txtEnlistmentDate.Value, "dd/mm/yyyy")
' Sort out 1900 date issue
If Left(CDate(Sheets(Sht.Name).Cells(Cnt2, Cnt + 1)), 4) <> 1900 Then
frmEnlistment.txtEnlistmentDate.Text = Format(Sheets(Sht.Name).Cells(Cnt2, Cnt + 1), "dd/mm/yyyy")
Else
frmEnlistment.txtEnlistmentDate.Text = CStr(Sheets(Sht.Name).Cells(Cnt2, Cnt + 1))
End If
Exit For
End If
Next Cnt
Exit For
End With
End If
Next Sht
With Sheets(Sht.Name)
Set SortRange = .Range(.Cells(3, Cnt), .Cells(LastRow + 1, Cnt + 1))
End With
With SortRange
.Sort Key1:=Cells(3, Cnt), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
frmEnlistment.txtSoldierNumber.Text = vbNullString
frmEnlistment.txtEnlistmentDate.Text = vbNullString
frmEnlistment.lboRegiment.ListIndex = -1
frmEnlistment.lboBattalion.ListIndex = -1
End Sub
Or is this because of the leap year issue? Entering 23/01/1900 (d/m/y) goes in correctly.
Then 03/02/1900 (d/m/y) inputs as 02/03/1900, with 13/02/1900 (d/m/y) correctly again.
It appears that every date in 1900 that has a day that could also be a month i.e. from the 1st through to the 12th, then these are entered back to front. Any date after 12th is entered correctly.