none
Add Due date based on multiple criteria in UserForm RRS feed

  • Question

  • Hi,

    I have a userform where I have multiple entry like name, address, admission date, type of payment dues (like annually, half yearly etc). I was able to record all these infomration in a worksheet. But there is something I got stuck to. I want to add all subsequent due date in the worksheet (lets say sheet 1) based on the admission date and the due type (like annually or half yearly) for each person. An example is : if I fill admission date 1/23/2020 and select "Half Yearly" in user form against a person name called 'XX' I want to add all due dates for next six months (as it is half yearly) in the same row against 'XX' (1/23/2020, 2/23/2020, 3/23/2020, 4/23/2020, 5/23/2020, 6/23/2020). and so on. Could someone please help with a VBA code?

    Thanks,

    Greg Medhi.

    Tuesday, January 28, 2020 6:29 AM

Answers

  • Hi,

    I modified Sheet1 and VBA code.


    Code:
    ' --- this code is in a Sheet
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim startCol As Integer: startCol = 4
        Dim endCol As Integer   ' -- varies by type of enrollment
        ' ---
        If Not (Intersect(Target, Range("C2:C100")) Is Nothing) Then
            Select Case Cells(Target.Row, 3).Value
                Case Is = "Annual"
                    endCol = startCol + 11
                Case Is = "Half Yearly"
                    endCol = startCol + 5
                Case Is = "Quarterly"
                    endCol = startCol + 3
                Case Else
                    Range(Cells(Target.Row, 4), Cells(Target.Row, 15)).Value = ""
                    Exit Sub
            End Select
            ' ---
            Dim addMonth As Integer: addMonth = 0
            Dim col As Integer
            ' ---
            For col = startCol To endCol
                Cells(Target.Row, col).Value _
                    = DateAdd("m", addMonth, Cells(Target.Row, 2).Value)
                addMonth = addMonth + 1
            Next
        End If
    End Sub

    Regards,

    Ashidacchi -- http://hokusosha.com

    • Marked as answer by GMedhi Wednesday, January 29, 2020 8:50 PM
    Wednesday, January 29, 2020 2:45 AM

All replies

  • Hi,

    I'd like to confirm your requirement:
    1) Provide all types of payment and examples of due date (admission date, type, 1st date, 2nd date, 3rd data)

    2) Is your example correct?  I suppose due date is 7/23/2020, 1/23/2021, 7/23/2021,..., if admission date is 1/23/2020 and type is Half Yearly.
    Or a user should pay in every month (or type of payment dues means payment period) ? 

    Regards,

    Ashidacchi -- http://hokusosha.com


    • Edited by Ashidacchi Tuesday, January 28, 2020 10:20 AM
    Tuesday, January 28, 2020 10:19 AM
  • Hi,

    I've made a sample.

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not (Intersect(Target, Range("D2:D100")) Is Nothing) Then
            Dim addMonth As Integer
            Dim offset As Integer: offset = 1
            Dim col As Integer
            For col = 5 To 10
                Select Case Cells(Target.Row, 4).Value
                    Case Is = "Monthly"
                        addMonth = 1
                    Case Is = "Biannual"
                        addMonth = 6
                    Case Is = "Yearly"
                        addMonth = 12
                    Case Else
                        Range(Cells(Target.Row, 5), Cells(Target.Row, 10)).Value = ""
                        Exit Sub
                End Select
                ' ---
                Cells(Target.Row, col).Value _
                    = DateAdd("m", addMonth * offset, Cells(Target.Row, 3).Value)
                offset = offset + 1
            Next
        End If
    End Sub
    I'm not sure if I can understand your requirement.
    I hope you will answer my previous post.

    Regards,

    Ashidacchi -- http://hokusosha.com

    • Proposed as answer by Ashidacchi Wednesday, January 29, 2020 2:36 AM
    Tuesday, January 28, 2020 12:07 PM
  • Thank you for your reply. I apologize for my question not be very clear. Let me explain in a more details.

    In Column 'A'  I have Person Name, column 'B' Admission Date and In Column 'C' Enrollment Type (which can be annual or half yearly or quarterly). Irrespective of enrollment type payment is due on monthly basis. so if I select quarterly Enrollment Type and the admission date is on 1/28/2020, excel will fill next 3 successive column (Column D, E and F) with due date: 1/28/2020, 2/28/2020, 3/28/2020. If the enrollment type is Half Yearly it will fill up due date for 6 month (column D, E,F, G, H and I) and so on. Hope this clarifies. 


    Tuesday, January 28, 2020 7:01 PM
  • Hi,

    I modified Sheet1 and VBA code.


    Code:
    ' --- this code is in a Sheet
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim startCol As Integer: startCol = 4
        Dim endCol As Integer   ' -- varies by type of enrollment
        ' ---
        If Not (Intersect(Target, Range("C2:C100")) Is Nothing) Then
            Select Case Cells(Target.Row, 3).Value
                Case Is = "Annual"
                    endCol = startCol + 11
                Case Is = "Half Yearly"
                    endCol = startCol + 5
                Case Is = "Quarterly"
                    endCol = startCol + 3
                Case Else
                    Range(Cells(Target.Row, 4), Cells(Target.Row, 15)).Value = ""
                    Exit Sub
            End Select
            ' ---
            Dim addMonth As Integer: addMonth = 0
            Dim col As Integer
            ' ---
            For col = startCol To endCol
                Cells(Target.Row, col).Value _
                    = DateAdd("m", addMonth, Cells(Target.Row, 2).Value)
                addMonth = addMonth + 1
            Next
        End If
    End Sub

    Regards,

    Ashidacchi -- http://hokusosha.com

    • Marked as answer by GMedhi Wednesday, January 29, 2020 8:50 PM
    Wednesday, January 29, 2020 2:45 AM
  • This is exactly what I was looking for. Thank you very much for your help. 
    Wednesday, January 29, 2020 8:50 PM