Consulting

Page 1 of 3 1 2 3 LastLast
Results 1 to 20 of 54

Thread: Predict Date of Enlistment

  1. #1
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location

    Predict Date of Enlistment

    This is a project that I have been meaning to look at for a couple of years (since the 100th anniversary of the end of WW1 in 2018).
    What I need this to do is two things:


    1. Provide the ability to enter a service number and date of enlistment to add to the correct Regiment / Battalion combination. These details will be factual and obtained from surviving service records.
    2. Provide a facility of obtaining the most accurate estimate of when a particular person may have enlisted, using their service number, based on the data that is already available.

    Obviously, the result for obtaining 2) will provide a more accurate result with each entry that is input in 1).
    Each time a new value is input into 1), then it should be added into the respective worksheet according to Regiment, Battalion, service number, then date of enlistment.

    The top half of the UserForm handles the inputting of “new” data, whilst the bottom half deals with any enquiry. The bottom right box should indicate how accurate the predicted date is likely to be (Don't know if this is possible?).

    I think that the Excel function that is likely to produce the most accurate estimated date of enlistment is ‘Forecast’.

    My VBA / Excel knowledge is still in its infancy, so I am open to suggestions as to whether this is possible and what the most sensible way of achieving my goal might be. I have attached my initial thoughts and entered new worksheets for a few regiments, with accurate data for a couple. These will be added to in due course and should appear in the ComboBox in alphabetical (Regimental) order, then numerical (Battalion) order.
    I realise that this might be a big ask, but just in case someone fancied a bit of a challenge.

    Thanks!
    Attached Files Attached Files

  2. #2
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Seasons greetings to all!

    I've realised that I posted the wrong attachment.
    Attached Files Attached Files

  3. #3
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    Hi again HTCF. I don't understand your objective? U state "These details will be factual and obtained from surviving service records" but then U want to forecast their accuracy... it's 100%. I can't imagine that all the records are not surviving and so they would be available somewhere. I don't see any accuracy to forecast? Even if the records didn't survive, it seems to me that once they are provided by some valid source, then the accuracy would again be 100% with nothing to forecast. I fully support your effort to assist the heroes of the past but I just don't understand them. Dave

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    What is the algorithm for #2?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  5. #5
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Hello Dave / Sam, alas the service records for WW1 were mostly destroyed by the Luftwaffe during WW2. The remaining ones that were saved from the fires are what are being used to populate the worksheets.

    The forecasting of accuracy will come from known service numbers, then calculating a "likely" enrolment date from say looking at between the two dates either side that are factually known, or if there is a large gap providing a date along with a tolerance of say +/- so many days.

    As more known service number / enrolment dates are entered, the theory being that the predicted dates will become more accurate. My hope is that expert's knowledge of Excel will be able to provide the most accurate method of producing a prediction.

    I've been tinkering with the first part - populating the known service numbers / enrolment dates. Of course I'm struggling, but understand that the only way to learn is to try.

    Option Explicit
    
    Private Sub UserForm_Click()
    
        Dim ShCount As Integer, i As Integer, j As Integer, ws As Worksheet
    
        ' Sort Regiment worksheets alphabetically
        Application.ScreenUpdating = False
        
        ShCount = Sheets.Count
        
        For i = 1 To ShCount - 1
            For j = i + 1 To ShCount
                If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
                    Sheets(j).Move before:=Sheets(i)
                End If
            Next j
        Next i
        
        ' Populate Regiment
        For Each ws In Worksheets
            cboRegiment.AddItem ws.Name
        Next ws
        
        ' Populate Battalion
        Dim index  As Integer
        index = cboRegiment.ListIndex
        
        cboBattalion.Clear
        
        Application.ScreenUpdating = True
        
    End Sub
    
    Private Sub cmbEnter_Click()
    
        ' Input known soldier's number and enlistment date
    
        Dim n As Variant, answer As String, ws As Worksheet
        Set ws = Worksheets(ActiveSheet)
        
        n = Application.InputBox("Please Enter Soldier Number", "Enlistment Database", "Enter Number Here", , , , 1)
        
        answer = InputBox("Please enter known enlistment date in the following format: dd-mm-yyyy", "Enlistment Database", Format(Date, "dd/mmm/yyyy"))
        
        If answer = "" Or n = "" Then
            Exit Sub
        Else
            
            If n <> "" And IsNumeric(n) = True Then
                
                answer = Format(answer, "DD/MM/YYYY")
                ' Validate date
                If Not IsDate(answer) Or Not answer Like "[0-2]#/[01]#/[12][08]##" Then
                    If MsgBox("Invalid date or invalid date format" & _
                       "Please enter the date in the correct format", vbRetryCancel) = vbRetry Then
                        Exit Sub
                    Else
                        answer = Format(answer, "DD/MMM/YYYY")
                        Exit Sub
                    End If
                End If
                
            End If
            
            ' find the end of column A
            Dim x As Integer
            x = 1
            Do Until ws.Range("A" & x).Value = ""
                x = x + 1
            Loop
            ' last row having data = x-1
            
            ' Add data to database
            ws.Range("A" & x).Value = txtSoldierNumber.Value
            ws.Range("B" & x).Value = txtEnlistmentDate.Value
            
            ' Clear text boxes
            txtSoldierNumber.Value = ""
            txtEnlistmentDate.Value = ""
            
        End If
    End Sub
    I can forsee that this will only be of use for the 1st Battalion and providing I can get it to choose the right regiment!

  6. #6
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    Here's a start. Unfortunately I axed all of your code. HTH. Dave
    Attached Files Attached Files

  7. #7
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Many thanks, Dave. Don't mind at all you axing the code if there is a more efficient way. Always looking to learn.

  8. #8
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Sticking with the first part of trying to enter new Soldier numbers and Enlistments date.
    Attached Files Attached Files

  9. #9
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    Soldier entry is done... my apologies for axing your code again. I leave the rest to you. If U enter the soldier number enquiry, U need to find the sheet (regiment), then the battalion and then search for the soldier number to see if it exists. If it does, show the date of enlistment. If it doesn't show the dates of the enlistment number before the soldier number and the date of the enlistment number after the soldier number. There is no accuracy prediction. HTH. Dave
    Attached Files Attached Files

  10. #10
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Dave, absolutely no need to apologise for axing my code. My appreciation goes to you for progressing the project!

    The only thing that I would make comment on, is that the date is input as text, so it produces the dreaded left aligned text field which will not format to a date when trying to change the properties of the cell / column.

    I'm going to have a bit of a dig around to see if this can be rectified at code source.

    It looks like CDate will be the answer.

    Thanks again!
    Last edited by HTSCF Fareha; 12-28-2020 at 10:21 AM.

  11. #11
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Scratch the last! It was me using an existing table for data.
    Although there is something strange happening.....

    2580 12/01/1888
    3085 01/03/1889
    3462 14/01/1890
    3753 20/01/1891
    4034 20/03/1892
    4663 26/09/1893
    5015 01/09/1894
    5249 28/01/1895
    5671 23/04/1896
    6044 10/08/1897
    6312 20/07/1898
    6571 24/07/1899
    6747 03/01/1900
    6928 26/02/1901
    7233 07/08/1902
    7413 19/01/1903
    7947 02/05/1904
    Last edited by HTSCF Fareha; 12-28-2020 at 02:31 PM.

  12. #12
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    HTSCF it doesn't matter what it looks like when it's stored in the worksheet. You will be displaying the date on the userform. As far as I could tell, the sheet itself or the sample data that U had included was oddly formatted. If U blank all the data from the worksheets(regiments) and re-enter the soldier info, then all the date data on the worksheet(s) would be the same... not that it matters. Dave

  13. #13
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    My thanks to Dave for getting things this far.

    The next part is what I was really hoping to achieve - a means of predicting an enlistment date based on known dates.

    My initial thought was to perhaps use the Forecast function. Do we think this might be the way forward?
    Attached Files Attached Files

  14. #14
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    HTSCF please review #9... I've already given U a path forward. The soldier number if unknown, will be enlisted somewhere between the date of the soldier number before and the date of the soldier number after. Dave

  15. #15
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    I hadn't forgotten the advice in post #9 Dave, I was just posing the question as to whether there was perhaps another way to provide a more mathmatical (accurate) means of obtaining an enlistment date.

    Take the following selection:-

    Soldier Number Confirmed Date of Enlistment
    13 06/09/1881
    196 13/01/1882
    617 05/01/1883
    1491 18/09/1884
    If one was to enquire when say soldier 15 enlisted for example, logic would suggest a date much nearer to #13 than to #196. Whereas your suggested method, if I am understanding correctly, will provide a date of 06/09/1881 + 64.5 days, giving a date of 10/11/1881 (when rounded up).

    Adding a few more known numbers / dates for the same Regiment, one arrives at the following:-

    13 06/09/1881
    59 16/10/1881
    62 16/10/1881
    64 17/10/1881
    72 21/10/1881
    110 11/11/1881
    196 13/01/1882

    So the method of date prediction will need to be able to calculate and allow for multiple enlistments on the same day.
    Last edited by HTSCF Fareha; 12-31-2020 at 12:26 PM.

  16. #16
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    I'm getting some bizarre results when inputting dates after 1900. All dates so far entered from 1881 to 1899 were all entered correctly (UK date format dd/mm/yyyy). Entering anything over 01/01/1900 (1st January 1900) switches the date and month about.

    Does anyone know why this happens and how this might be overcome?
    Attached Files Attached Files

  17. #17
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Forgot to show the code re the last post.

    For Each Sht In ThisWorkbook.Sheets
            If frmEnlistment.ListBox1.List(frmEnlistment.ListBox1.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.ListBox2.List(frmEnlistment.ListBox2.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")
                            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

  18. #18
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    HTSCF The rate of enlistment is unknown and likely inconsistent making the validity of projections uncertain... seems like a lot of work to produce erroneous results. You could look at the rate of enrollment over time for some period before the soldier in question and the rate of enrollment for some period after the soldier in question and then try to average these rates to "project" the actual date of enrollment... again I'm uncertain if there's any value to doing this. Dave
    Vba converting date string to 1900 date (microsoft.com)

    Differences between the 1900 and the 1904 date system - Office | Microsoft Docs

  19. #19
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    I think that you're right, Dave. Now I've been entering dates, there are all sorts of permetations that I'm coming across.

    My thinking is to let the user enter a service number, then have the VBA form show five enlistment dates / service numbers that are known either side of the query, thus allowing the user to make their own reasoned guestimate as to the actual date of enlistment.

    I'm now going to have a read of the two links to see if there is a way around the date issue.

    Thanks again for your feedback!

  20. #20
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    This seems to work for dates after 01/01/1900, after reading the suggestions in the first link, but obviously fails for earlier dates.

    Option Explicit
    Sub DateTest()
        Dim Sht    As Worksheet, r As Variant
        Dim rangeAll   As Excel.Range
        Set Sht = ActiveWorkbook.Worksheets("Sheet1")
        Set rangeAll = Sht.Range("A1:A20")
        Dim formulaString As String
        For Each r In rangeAll
            formulaString = "=Text(""" & r.Value & """,""DD/MM/YYYY"")"
            r.Value = formulaString
        Next r
    End Sub
    How would one incorprate it into the existing code? Would it need an "else if" scenario to read the differences in the input for dates > 31/12/1899 using the exisiting code, then another section for dates < 01/01/1900

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •