Evaluate Overlapping Date Ranges for MULTIPLE Rows - vb.net

I have a table that populates with an ID,Closed and Reopen Date. If I edit the date range for a particular ID. I need a way to check for overlapping dates across ALL date ranges in the table against the desired ID I changed. I have tried this below but am only evaluating on a row by row basis. Given the example below how could I get for example ID 2 to evaluate across all 6 rows if i changed closed to 9/17/2017?
Dim b As String = ddlB.SelectedValue
Dim l As String = ddlL.SelectedValue
Dim evaluatedID As Integer = ID.Value
Dim evaluatedClosedDate As Date = rdpCloseDate.SelectedDate
Using sta As New dsdMyDataset.MyTableAdapter
sta.Connection = My.DataHandler.MyDBConnection
Dim tbl As New dsdMyDataset.MyDataTable
sta.Fill(tbl, b, l)
For Each row In tbl
If evaluatedID < row.ID And evaluatedClosedDate < row.ReopenedDate Then
Return False
ElseIf evaluatedID = row.ID And evaluatedClosedDate < row.ReopenedDate Then
Return False
ElseIf evaluatedID > row.ID And evaluatedClosedDate > row.ReopenedDate Then
Return False
ElseIf evaluatedID = Nothing OrElse evaluatedClosedDate = Nothing OrElse row.ReopenedDate = Nothing Then
Return False
Else
Return True
End If
Next
End Using

Related

Linq Lowest Unique Value or Lowest Row and Column Value Whichever Exact match or Partial Match Whichever is Value is smaller

Hello I'm trying to develop a Linq query to find the Lowest Unique Value or Lowest Value also sorted by Row and Column Value.
First it does the Lowest Unique Value Exact match (unique value)
If nothing is found then it does a Partial Match (lowest value then lowest row then column)
Whichever has the smallest Value is the output (unique or not found).
Table of Data
Row
Column
Value
1
1
2
0
2
3
0
2
2
The output should be the last data in the table 0,2,2 since it has the lowest Row and it's a duplicate Value (row 1 and row 0).
if you add Data 2,0,0 (Value of 0) would overrule the duplicate Values (2's).
Row
Column
Value
1
1
2
0
2
3
0
2
2
2
0
0
Structure FoundValue
Dim Value As Short
Dim Row As Integer
Dim Column As Integer
End Structure
Dim UniqueValuesFound As New List(Of Short)
Dim ValuesFoundInPath As New List(Of FoundValue)
UniqueValuesFound.Add(0)
UniqueValuesFound.Add(2)
UniqueValuesFound.Add(3)
Dim foundValue As New FoundValue
foundValue.Value = 2
foundValue.Row = 1
foundValue.Column = 1
ValuesFoundInPath.Add(foundValue)
foundValue = New FoundValue
foundValue.Value = 3
foundValue.Row = 0
foundValue.Column = 2
ValuesFoundInPath.Add(foundValue)
foundValue = New FoundValue
foundValue.Value = 2
foundValue.Row = 0
foundValue.Column = 2
ValuesFoundInPath.Add(foundValue)
'foundValue = New FoundValue
'foundValue.Value = 0
'foundValue.Row = 2
'foundValue.Column = 0
'ValuesFoundInPath.Add(foundValue)
'New Attempt
Dim alreadyFound As Boolean = False
Dim matching = ValuesFoundInPath.Where(Function(s)
Dim index As Integer = UniqueValuesFound.BinarySearch(s.Value)
If alreadyFound = False AndAlso index >= 0 Then
alreadyFound = True
Return True 'UniqueValuesFound(index) 'exact match
ElseIf alreadyFound = False AndAlso index < 0 Then
alreadyFound = True
Return True 's.Value
Else
Return False
End If
End Function).OrderBy(Function(p) p.Value).ThenBy(Function(p) p.Row).ThenBy(Function(p) p.Column)
'New Attempt
Dim alreadyFound As Boolean = False
Dim matching = ValuesFoundInPath.Where(Function(s)
Dim index As Integer = UniqueValuesFound.BinarySearch(s.Value)
If alreadyFound = False AndAlso index >= 0 Then
alreadyFound = True
Return True 'UniqueValuesFound(index) 'exact match
ElseIf alreadyFound = False AndAlso index < 0 Then
alreadyFound = True
Return True 's.Value
Else
Return False
End If
End Function).OrderBy(Function(p) p.Value).ThenBy(Function(p) p.Row).ThenBy(Function(p) p.Column)
Look at 'New Attempt code it speaks itself, what I'm trying to do is find the first value which has a exact match in UniqueValuesFound and if it cannot find the value in UniqueValuesFound array then default to spitting out a partial match lowest value it can find. The array ValuesFoundInPath contains all the values in a random order as well as Column and Row types, which have to be sorted for partial match to find the lowest Row first.
I have finally Solved It!, needed to use Find instead of Where and problem disappeared!.
The answer now requires 2 linq queries instead of one cannot do chaining on Find
ValuesFoundInPath = ValuesFoundInPath.OrderBy(Function(p) p.Value).ThenBy(Function(p) p.Row).ThenBy(Function(p) p.Column).ToList()
Dim alreadyFound As Boolean = False
Dim matching = ValuesFoundInPath.Find(Function(s)
Dim index As Integer = UniqueValuesFound.BinarySearch(s.Value)
If alreadyFound = False AndAlso index >= 0 Then
alreadyFound = True
Return True 'UniqueValuesFound(index) 'exact match
ElseIf alreadyFound = False AndAlso index < 0 Then
alreadyFound = True
Return True 's.Value
Else
Return False
End If
End Function)
Dim result As New Result
result.Answer = matching.Value
result.CurrentRow = matching.Row
result.CurrentColumn = matching.Column
You may have problems since Find(...) pre-sorts the list of values always. So you need to use FindIndex(...) this avoids the sorting issue.
Dim matchingIndex = ValuesFoundInPath.FindIndex(Function(s)
Dim index As Integer = UniqueValuesFound.BinarySearch(s.Value)
If alreadyFound = False AndAlso index >= 0 Then
alreadyFound = True
Return True 'UniqueValuesFound(index) 'exact match
ElseIf alreadyFound = False AndAlso index < 0 Then
alreadyFound = True
Return True 's.Value
End If
Return False 'No match.
End Function)
If matchingIndex < 0 Then MessageBox.Show("Wtf!")
Dim result As New Result
result.Answer = ValuesFoundInPath(matchingIndex).Value
result.CurrentRow = ValuesFoundInPath(matchingIndex).Row
result.CurrentColumn = ValuesFoundInPath(matchingIndex).Column
It makes the OrderBy(...) useless because Find(...) pre-sorts the lists by incrementing values.

why i am getting this error "There is no row at position 0 vb.net"?

I am trying to add values from LANG_OBJ.TEXT to DataTableRow.
While adding i am getting a error:
There is no row at position 0
dtsaveTranslate = checkTranslateValues()
lang_id_text CType(Controls.Find("txt_id"True).FirstOrDefault(),TextB`enter code here`ox)
lang_de_text = CType(Controls.Find("txt_de", True).FirstOrDefault(), TextBox)
lang_row = dtsaveTranslate.NewRow()
lang_row("de") = lang_de_text
For Each row As DataRow In dtlang.Rows
lang_iso = Convert.ToString(row("ISO"))
lang_obj = CType(Controls.Find("txt_" + lang_iso, True).FirstOrDefault(), TextBox)
Dim len As Integer = lang_obj.Text.Length
Dim count_de As Integer = lang_de_text.Text.Length
progress.ProgressValue = len + 1
If Convert.ToString(row("isUbersetzen")) = "True" AndAlso lang_iso <> "de" Then
lang_obj.Text = lanClass.GoogleApiTranslate("de", Convert.ToString(row("ISO")), lang_de_text.Text.Trim())
lang_row(lang_iso) = lang_obj.Text
Else
count_txt = 0
End If
Next
dtsaveTranslate.Rows.Add(lang_row)
First you need to make sure that dtLang has rows and then try to loop them!
You need to make sure that dtLang is loaded with data. You should research why it doesn't contain any rows first. From the code above I can't see how the rows are loaded in there. Therefore, the proper check should start with:
If dtlang.Rows.count > 0 '<--- Added a check before looping
For Each row As DataRow In dtlang.Rows
lang_iso = Convert.ToString(row("ISO"))
lang_obj = CType(Controls.Find("txt_" + lang_iso, True).FirstOrDefault(), TextBox)
Dim len As Integer = lang_obj.Text.Length
Dim count_de As Integer = lang_de_text.Text.Length
progress.ProgressValue = len + 1
If Convert.ToString(row("isUbersetzen")) = "True" AndAlso lang_iso <> "de" Then
lang_obj.Text = lanClass.GoogleApiTranslate("de", Convert.ToString(row("ISO")), lang_de_text.Text.Trim())
lang_row(lang_iso) = lang_obj.Text
Else
count_txt = 0
End If
Next
End If

Exclude weekends in delivery date

I have a code that gets an ETA (estimated time of arrival) but I want it to exclude weekends. I also have it to change the ETA if its past 2:30PM.
Code:
Dim ETA1 As Date = Date.Today.AddDays(1)
Dim ETA2 As Date = Date.Today.AddDays(2)
Dim ETA3 As Date = Date.Today.AddDays(3)
Dim day As String = Format(Today, "dddd")
Dim time As Date
Dim CurrHour As Integer
Dim CurrMinute As Integer
time = DateTime.Now
CurrHour = time.Hour
CurrMinute = time.Minute
If StoreBox.Text Like "25*" Then
MicroLabel.Visible = True
If CurrHour >= 2 AndAlso CurrMinute >= 30 Then
ETABox.Text = ETA2
Else
ETABox.Text = ETA1
End If
Else
MicroLabel.Visible = False
If CurrHour >= 2 AndAlso CurrMinute >= 30 Then
ETABox.Text = ETA2
Else
ETABox.Text = ETA1
End If
End If
DateTime is a very flexible type which allows you to easily perform many date/time related actions. You don't need to perform a string-like analysis (what your code is doing).
For example, to take care of the two requested functionalities, just do something like:
Dim curTime As DateTime = Now
Dim goAhead As Boolean = True
If curTime.DayOfWeek = DayOfWeek.Saturday OrElse curTime.DayOfWeek = DayOfWeek.Sunday Then
goAhead = False
ElseIf curTime > New DateTime(curTime.Year, curTime.Month, curTime.Day, 14, 30, 0) Then
goAhead = False
End If
If goAhead Then
'Weekday before 2:30 PM
End If

How to copy whole column from one datagridview to another?

There are two datagridview (dgvReport and dgvReport2). dgvReport shows data from server after choosing the fields (which is working fine).
The checkboxes are the name of columns in dgvReport. If a user selects "Email" for example the column and its row data of "Email" should be added to dgvReport2.
My problem is when I select more than one checkbox the output of row is shown only at first column of dgvReport2 not under the appropriate column. For example, in the screenshot the column "fname" data is showing under email column of dgvReport2.
How can I bring the row data under appropriate column?
Below is my coding:
'Add dynamic column
Dim newCol As Integer = 0
If chkEmail.Checked = True Then
Dim column As New DataGridViewTextBoxColumn
dgvReport2.Columns.Insert(newCol, column)
With column
.HeaderText = "email"
.AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
.ReadOnly = True
End With
For rows As Integer = 0 To dgvReport.Rows.Count - 1
For colcnt As Integer = 0 To dgvReport.Columns.Count - 17
dgvReport2.Rows.Add(dgvReport.Rows(rows).Cells(0).Value)
Next
Next
newCol += 1
End If
If chkFname.Checked = True Then
Dim column As New DataGridViewTextBoxColumn
dgvReport2.Columns.Insert(newCol, column)
With column
.HeaderText = "fname"
.AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
.ReadOnly = True
End With
For rows As Integer = 0 To dgvReport.Rows.Count - 1
For colcnt As Integer = 0 To dgvReport.Columns.Count - 17
dgvReport2.Rows.Add(dgvReport.Rows(rows).Cells(1).Value)
Next
Next
newCol += 1
End If
I find out the answer of my own question. Hope fully it will help others who are looking for same issue:
replace
For rows As Integer = 0 To dgvReport.Rows.Count - 1
For colcnt As Integer = 0 To dgvReport.Columns.Count - 17
dgvReport2.Rows.Add(dgvReport.Rows(rows).Cells(0).Value)
Next
Next
with the following:
If dgvReport2.Rows.Count > 0 Then
For rows As Integer = 0 To dgvReport.Rows.Count - 1
dgvReport2.Rows(rows).Cells(newCol).Value =
dgvReport.Rows(rows).Cells(1).Value
Next
Else
For rows As Integer = 0 To dgvReport.Rows.Count - 1
dgvReport2.Rows.Add(dgvReport.Rows(rows).Cells(1).Value)
Next
End If

Finding if a date is in the Future or in the Past

'checks to see if date is within x days of the inputted date
Function isFutureDate(x) As Boolean
Dim daysFuture As Integer
Dim futureDate As Date
daysFuture = Sheet1.Range("e1").Value - 1
'we have to add one to not count today
futureDate = WorksheetFunction.WorkDay(Date, daysFuture)
If x >= Date And x < futureDate Then
isFutureDate = True
Else
isFutureDate = False
End If
End Function
'checks to see if date is in the past x days
Function isPastDate(x) As Boolean
Dim BDate As Date
Dim y As Date
Dim daysPast As Integer
'subtract one to not count today
daysPast = Sheet1.Range("E1").Value - 1 'subtract one to not count today
BDate = WorksheetFunction.WorkDay(Date, -1 * daysPast)
If x < Date And x > BDate Then
isPastDate = True
Else
isPastDate = False
End If
End Function
These are the two functions I have currently. x is passed as a Date. When I step through the program, I notice an error with BDate in the isPastDate function. In my file, I have a cell where the user enters how many days in the future they would like to see entries for. I think this is where my main problem is. When I check the value of daysFuture or daysPast I get 0 while the user entered value is clearly 7.
'checks to see if date is within x days of the inputted date
Function isFutureDate(x As Date) As Boolean
Dim xDays As Integer
Dim xFuture As Integer
xDays = Sheet1.Range("E1").Value
xFuture = DateDiff("d", Date, x)
If xFuture > xDays Then
isFutureDate = True
Else
isFutureDate = False
End If
End Function
'checks to see if date is in the past x days
Function isPastDate(x As Date) As Boolean
Dim xDays As Integer
Dim xPast As Integer
xDays = Sheet1.Range("E1").Value
xPast = DateDiff("d", Date, x)
If xPast < xDays Then
isPastDate = True
Else
isPastDate = False
End If
End Function