• notice
  • Congratulations on the launch of the Sought Tech site

vb.net the fourth Tuesday of the new year

I wrote a checkbook app that archives the 4th Tuesday of the month In the SQLite database, when the user writes a check and today's date is greater than the date on file, the database is updated with the new 4th Tuesday date and a function deposit SS payment is loaded.
While testing, I found that the first function I wrote would fail when the year changed.
So I wrote a second function to handle the change in Years.
The code appears to be working.I want to combine the quiz into one function because the code doesn't look elegant.I will post the small TEST application code below.These two functions are in one module.

Public Class frmStart
Dim varSearchDate As Date
Dim varFTue As Date

Private Sub frmStart_Load(sender As Object, e As EventArgs)  Handles MyBase.Load
    tbBox1.Text="2021-12-28" ' 2021-11-23 2021-12-28 TEST DATES
End Sub

Private Sub btnADD_Click(sender As Object, e As EventArgs)  Handles btnADD.Click
    varSearchDate=CDate(tbBox1.Text)
    tbAns.Text=varSearchDate.ToString("M-d-yyyy")

    Dim dateToday=Date.Today
    Dim mo As String
    mo=varSearchDate.ToString("MM")

    If dateToday > varSearchDate And CInt(mo) <> 12 Then
        varFTue=CDate(FourthTueOfNextMonth(Date.Today).ToString("yyyy-M-d"))
        MsgBox("varFTue Next Mo " & varFTue)
        tbBox2.Text=varFTue.ToString("yyyy-M-d")
        'WriteNewFourthTue()
        'gvTxType="SS Deposit"
    ElseIf dateToday > varSearchDate And CInt(mo)=12 Then
        varFTue=CDate(FourthTueOfNewYear(Date.Today).ToString("yyyy-M-d"))
        MsgBox("varFTue New Yr " & varFTue)
        tbBox3.Text=varFTue.ToString("yyyy-M-d")
        'WriteNewFourthTue()
        'gvTxType="SS Deposit"
    End If
End Sub

End class

These two functions and my TEST code are commented out with ONLY ONE FUNCTION

Module FunctionModule

'Function FourthTueOfNextMonth(dt As Date) As Date
' Dim currDate=New Date(dt.Year, dt.Month, 1)
' Dim nTuesday As Integer
' While nTuesday < 4
' If currDate.DayOfWeek=DayOfWeek.Tuesday Then
' nTuesday=1
' End If
' currDate=currDate.AddDays(1)
' End While
' If dt.Month <> 12 Then
' Return New Date(dt.Year, dt.Month, currDate.Day-1)
' ElseIf dt.Month=12 Then
' Return New Date(dt.Year 1, dt.Month-11, currDate.Day-1)
' End If
'End Function

Function FourthTueOfNextMonth(dt As Date) As Date
    Dim currDate=New Date(dt.Year, dt.Month, 1)
    Dim nTuesday As Integer

    While nTuesday < 4
        If currDate.DayOfWeek=DayOfWeek.Tuesday Then
            nTuesday=1
        End If
        currDate=currDate.AddDays(1)
    End While

    Return New Date(dt.Year, dt.Month, currDate.Day-1)

End Function

Function FourthTueOfNewYear(dt As Date) As Date
    Dim currDate=New Date(dt.Year 1, dt.Month-11, 1)
    Dim nTuesday As Integer

    While nTuesday < 4
        If currDate.DayOfWeek=DayOfWeek.Tuesday Then
            nTuesday=1
        End If
        currDate=currDate.AddDays(1)
    End While

    Return New Date(dt.Year 1, dt.Month-11, currDate.Day-1)

End Function

Terminal Module

My question is is there a better way to write this code, so I just have a function?

uj5u.com enthusiastic netizens replied:

This is a function that finds the fourth Tuesday of the next month based on the date passed in :

Function FourthTueOfNextMonth(dt As Date) As Date
    ' Start with the First Day of the Month, from the date passed in.
    ' Add one Month to that to get the first Day of the NEXT month.
    Dim currDate As Date=(New Date(dt.Year, dt.Month, 1)).AddMonths(1)
    ' Find the First Tuesday of the Month
    While currDate.DayOfWeek <> DayOfWeek.Tuesday
        currDate=currDate.AddDays(1)
    End While
    ' Add three more Weeks to jump to Fourth Tuesday
    Return currDate.AddDays(21)
End Function

Please note that this function always returns the fourth Tuesday of the next month, and it does not Checks if the incoming date is less than the fourth Tuesday of the same month that contains the incoming date.

Tags

Technical otaku

Sought technology together

Related Topic

1 Comments

author

order atorvastatin 20mg generic & lt;a href="https://lipiws.top/"& gt;buy atorvastatin pills& lt;/a& gt; order lipitor 10mg

Jsemcl

2024-03-08

Leave a Reply

+