SSIS recordset in script task: cannot use it with subsequent rows - vb.net

I am using a script task in SSIS in which I am using three different recordsets to add rows to the data flow. Everything works well for the first use of these recordsets, but when additional rows need to access the recordsets, there is no data in them.
What I am trying to do is to take these rows in the incoming data flow:
ID | mScale | startDate | End Date ....
1 | w | 7/8/13 | 10/31/13
1 | m | 11/1/13 | 3/31/14
1 | q | 4/1/14 | 7/31/14
2 | w | 7/8/13 | 10/31/13
2 | m | 11/1/13 | 3/31/14
2 | q | 4/1/14 | 7/31/14
And add rows so the outgoing data flow looks like this:
ID | pScale | startDate | EndDate
1 | w | 7/8/13 | 7/14/13
1 | w | 7/15/13 | 7/21/13
....
1 | w | 10/28/13 | 10/31/13
1 | m | 11/1/13 | 11/30/13
1 | m | 12/1/13 | 12/31/13
...
1 | m | 3/1/14 | 3/31/14
1 | q | 4/1/14 | 6/30/14
1 | q | 7/1/14 | 7/31/14
2 | w | 7/8/13 | 7/14/13
2 | w | 7/15/13 | 7/21/13
....
2 | w | 10/28/13 | 10/31/13
2 | m | 11/1/13 | 11/30/13
2 | m | 12/1/13 | 12/31/13
...
2 | m | 3/1/14 | 3/31/14
2 | q | 4/1/14 | 6/30/14
2 | q | 7/1/14 | 7/31/14
The recordsets contain the weekly, quarterly and monthly start and end dates.
The output rows with the ID of 1 are being created, the output rows with the ID of 2 are not.
I've found information on the internet that says that you can't iterate over the same recordset twice. I'm wondering if there is a way to regenerate the recordset or reuse it somehow? Or do I need to rethink this whole design?
Thoughts appreciated, script below.
' Microsoft SQL Server Integration Services Script Component
' Write scripts using Microsoft Visual Basic 2008.
' ScriptMain is the entry point class of the script.
Imports System
Imports System.Data
Imports System.Math
Imports Microsoft.SqlServer.Dts.Pipeline.Wrapper
Imports Microsoft.SqlServer.Dts.Runtime.Wrapper
Imports System.Xml
Imports System.Data.OleDb
<Microsoft.SqlServer.Dts.Pipeline.SSISScriptComponentEntryPointAttribute()> _
<CLSCompliant(False)> _
Public Class ScriptMain
Inherits UserComponent
Public Overrides Sub Input0_ProcessInputRow(ByVal Row As Input0Buffer)
Dim oleDA As New OleDbDataAdapter
Dim dt As New DataTable
Dim j As Integer
Dim Difference As TimeSpan
Try
If Row.mScale = "w" Then
'create 17 new rows, pull start date and enddate from the excel sheet.
oleDA.Fill(dt, Me.ReadOnlyVariables("User::WeeklyData").Value)
If dt.Rows.Count > 0 Then
'loop through and find the proper start date,
j = 0
For Each dtRow As Data.DataRow In dt.Rows
Dim dtStartDate As String = dt.Rows(j)("StartDate").ToString
Dim dfStartDate As String = Row.oStartDate.ToString
If dfStartDate = dtStartDate Then
'start here to populate the next 17 rows.
Exit For
Else
j = j + 1
End If
Next
For i = 1 To 17
With Output0Buffer
.AddRow()
.PlanID = Row.PlanID
.oStartDate = dt.Rows.Item(j)(0).ToString
.aFID = Row.aFID
.oEndDate = dt.Rows.Item(j)(1).ToString
.pScale = Row.mScale
.pCount= 1
.nwDays = Weekdays(dt.Rows.Item(j)(0), dt.Rows.Item(j)(1))
.CreateDate = Today
.ModDate = Today
j = j + 1
End With
Next
End If
End If
If Row.mScale = "m" Then
'create 7 new rows, pull start date and enddate from the excel sheet.
'where to start - the start of the month that is two months out from the project start date?
'how to add two months to the date?
oleDA.Fill(dt, Me.ReadOnlyVariables("User::MonthlyData").Value)
If dt.Rows.Count > 0 Then
'loop through and find the proper start date,
j = 0
For Each dtRow As Data.DataRow In dt.Rows
Dim dtStartDate As String = dt.Rows(j)("StartDate").ToString
Dim dfStartDate As String = Row.oStartDate.AddMonths(-2).ToString
'Subtract two months from start date.
If dfStartDate <= dtStartDate Then
'start here to populate the next 7 rows.
Exit For
Else
j = j + 1
End If
Next
For i = 1 To 7
With Output0Buffer
.AddRow()
.PlanID = Row.PlanID
.oStartDate = dt.Rows.Item(j)(0).ToString
.aFID = Row.aFID
.oEndDate = dt.Rows.Item(j)(1).ToString
'need to store this in a variable to use for the start of the quarterly dates.
.pScale = Row.mScale
.pCount= 1
'Calculate .nwDays
'NumWorkDays = dt.Rows.Item(j)(1).Subtract(dt.Rows.Item(j)(0).ToString)
'.nwDays = NumWorkDays.TotalDays
.nwDays = Weekdays(dt.Rows.Item(j)(0), dt.Rows.Item(j)(1))
.CreateDate = Today
.ModDate = Today
j = j + 1
End With
Next
End If
End If
If Row.mScale = "q" Then
'create x new rows, pull start date and enddate from the excel sheet.
oleDA.Fill(dt, Me.ReadOnlyVariables("User::QuarterlyData").Value)
If dt.Rows.Count > 0 Then
'loop through and find the proper start date,
j = 0
For Each dtRow As Data.DataRow In dt.Rows
Dim dtStartDate As String = dt.Rows(j)("StartDate").ToString
If Row.oStartDate <= dtStartDate Then
'start here to populate the next x rows until the project end date.
Exit For
Else
j = j + 1
End If
Next
While dt.Rows.Item(j)(0) <= Row.UpdateAccIDprojEndDate
With Output0Buffer
.AddRow()
.PlanID = Row.PlanID
.oStartDate = dt.Rows.Item(j)(0).ToString
.aFID = Row.aFID
'IF THIS IS WITHIN THE QUARTER WE'RE ON, THEN POPULATE WITH PROJECT END DATE.
Difference = dt.Rows.Item(j)(1).Subtract(Row.UpdateAccIDprojEndDate)
If (Row.UpdateAccIDprojEndDate < dt.Rows.Item(j)(1)) Then
.oEndDate = Row.UpdateAccIDprojEndDate
.nwDays = Weekdays(dt.Rows.Item(j)(0), Row.UpdateAccIDprojEndDate)
Else
.oEndDate = dt.Rows.Item(j)(1).ToString
.nwDays = Weekdays(dt.Rows.Item(j)(0), dt.Rows.Item(j)(1))
End If
.pScale = Row.mScale
.pCount= 1
.CreateDate = Today
.ModDate = Today
j = j + 1
End With
End While
End If
End If
Catch ex As Exception
Throw ex
Finally
'use this to do something even if the script task fails.
End Try
End Sub
Private Function Weekdays(ByRef startDate As Date, ByRef endDate As Date) As Integer
Dim numWeekdays As Integer
Dim totalDays As Integer
Dim WeekendDays As Integer
numWeekdays = 0
WeekendDays = 0
totalDays = DateDiff(DateInterval.Day, startDate, endDate) + 1
For i As Integer = 1 To totalDays
If DatePart(DateInterval.Weekday, startDate) = 1 Then
WeekendDays = WeekendDays + 1
End If
If DatePart(DateInterval.Weekday, startDate) = 7 Then
WeekendDays = WeekendDays + 1
End If
startDate = DateAdd("d", 1, startDate)
Next
numWeekdays = totalDays - WeekendDays
Return numWeekdays
End Function
End Class

A simple workaround would be to create three DataTable objects as member variables in your script class - one each for the weekly, monthly and quarterly date lists. Populate them once in the PreExecute sub of your script component, and then use them in the ProcessInputRow sub:
Public Class ScriptMain
Inherits UserComponent
Private _monthlyDates As New DataTable
Private _weeklyDates As New DataTable
Private _quarterlyDates As New DataTable
Public Overrides Sub PreExecute()
MyBase.PreExecute()
Dim monthlyDa As New OleDbDataAdapter
Dim weeklyDa As New OleDbDataAdapter
Dim quarterlyDa As New OleDbDataAdapter
monthlyDa.Fill(_monthlyDates, Me.Variables.MonthlyDates)
weeklyDa.Fill(_weeklyDates, Me.Variables.WeeklyDates)
quarterlyDa.Fill(_quarterlyDates, Me.Variables.QuarterlyDates);
End Sub
Public Overrides Sub Input0_ProcessInputRow(ByVal Row As Input0Buffer)
Dim dataTableToCheck As DataTable
Dim periodStart As Date
Dim periodEnd As Date
Dim periodFound As Boolean = False
' Choose the appropriate data table based on the mScale value
Select Case Row.mScale
Case "w"
dataTableToCheck = _weeklyDates
Case "m"
dataTableToCheck = _monthlyDates
Case "q"
dataTableToCheck = _quarterlyDates
Case Else
dataTableToCheck = Nothing
End Select
' Do whatever's appropriate with that data
' This example populates PeriodStart and PeriodEnd columns
' based on the row's StartDate and whether it's a weekly, monthly or quarterly period
If Not (dataTableToCheck Is Nothing) Then
For Each dtRow As Data.DataRow In dataTableToCheck.Rows
periodStart = CDate(dtRow("StartDate"))
periodEnd = CDate(dtRow("EndDate"))
If periodStart <= Row.StartDate And Row.StartDate <= periodEnd Then
periodFound = True
Exit For
End If
Next
If periodFound Then
Row.PeriodStart = periodStart
Row.PeriodEnd = periodEnd
Else
Row.PeriodStart_IsNull = True
Row.PeriodEnd_IsNull = True
End If
End If
End Sub
End Class

Related

Faster way to loop through DataTable elements

Description of the current situation:
I have an excel file of approximately 315 columns and 4000 rows. The file contains the answers to a 300-question questionnaire. The data format is as follows:
(Headers) A | B | C | D | E | F | Q.1 | Q.2 | ... | Q.300 |
(FirstRow) Info of first participant | AnswerCode for every Q |
The columns A to F contain contain info on every participant, while the columns Q.1 to Q.300 contain the respective answer code to each question. After storing the file as a large DataTable:
I need to load all 4000 rows on an existing database table, but before I do that I must edit the data format. The end result must become:
ParticipantCode | QuestionCode | AnswerCode | DateOfRegistration
00001 | 0001 | 1234567 | yyyy-MM-dd HH:mm:ss
... | ... | ... | ...
00001 | 0300 | 1234567 | yyyy-MM-dd HH:mm:ss
00002 | 0001 | 1234567 | yyyy-MM-dd HH:mm:ss
... | ... | ... | ...
04000 | 0300 | 1234567 | yyyy-MM-dd HH:mm:ss
So every row of the original ExcelDataTable is transformed into 300 rows in the FinalDataTable. In this way, the FinalDataTable will have about 1.2 million rows.
What Have I implemented so far:
Private Function MyFunction()
For Each ExcelRow As DataRow In ExcelDataTable.Rows
For Each ExcelColumn As DataColumn In ExcelDataTable.Columns
QuestionCodeFound = False
ExcelColumnNameRaw = ExcelColumn.ColumnName.ToString.Trim
If ExcelColumnNameRaw.StartsWith("Q") Then
' Correct the headers
ExcelColumnSplit = ExcelColumnNameRaw.Split("#")
ExcelColumnName = String.Concat(ExcelColumnSplit(0), ExcelColumnSplit(1))
SelectedRowFromDT = QuestionCodeAndQuestionIDDataTable.Select("QuestionID = '" + ExcelColumnName + "'")
' Search for "_", because some questions are different
If SelectedRowFromDT.Length > 0 Then
QuestionCodeFound = True
Else
Dim ExcelColumnSplitForMult As String()
ExcelColumnSplitForMult = ExcelColumnName.Split("_")
SelectedRowFromDT = QuestionCodeAndQuestionIDDataTable.Select("QuestionID = '" + ExcelColumnSplitForMult(0).ToString + "'")
If SelectedRowFromDT.Length > 0 Then
QuestionCodeFound = True
End If
End If
If QuestionCodeFound Then
Dim QuestionCode As String
Dim QuestionTypeDataTable As DataTable
Dim QuestionType As String
' Get the Question Type from the respective table
QuestionType = String.Empty
QuestionCode = SelectedRowFromDT(0).Item("QuestionCode").ToString
QuestionTypeDataTable = SearchInSql(My.Settings.ConnectionString, SQLString)
If QuestionTypeDataTable.Rows.Count > 0 Then
QuestionType = QuestionTypeDataTable.Rows(0).Item(0).ToString.Trim
End If
' Fix the Date Format
DateRaw = ExcelRow.Item(1).ToString
DateSplit = DateRaw.Split("/")
If DateSplit(0).Length = 1 Then
DateSplit(0) = String.Concat("0", DateSplit(0))
End If
If DateSplit(1).Length = 1 Then
DateSplit(1) = String.Concat("0", DateSplit(1))
End If
DateText = String.Concat(DateSplit(0), "/", DateSplit(1), "/", DateSplit(2))
DateRegistration = DateTime.ParseExact(DateText, "MM/dd/yyyy", CultureInfo.InvariantCulture)
DateRegistrationReformed = DateRegistration.ToString("yyyy-MM-dd", CultureInfo.InvariantCulture)
DateRegFinal = DateTime.ParseExact((DateRegistrationReformed + " " + "10:00:00").ToString, "yyyy-MM-dd HH:mm:ss", CultureInfo.InvariantCulture)
Dim AnswerValue As String
Dim AnswerCode As String
Dim AnswerCodeDataTable As DataTable
Dim QuestionWasAnswer As String
Dim AnswerValueRow() As DataRow = ExcelDataTable.Select("ParticipantCode = '" + ExcelRow.Item(2).ToString + "'")
AnswerCodeDataTable = New DataTable
AnswerValue = ""
QuestionWasAnswer = "0"
' Complete "QuestionWasAnswer" field for all questions and retrieve the AnswerCode for the answer given by each participant
If AnswerValueRow.Length > 0 And AnswerValueRow(0).Item(ExcelColumnNameRaw).GetType IsNot GetType(DBNull) Then
If Not (QuestionType.Equals("02") Or QuestionType.Equals("03")) Then
AnswerValue = AnswerValueRow(0).Item(ExcelColumnNameRaw)
QuestionWasAnswer = "1"
ElseIf QuestionType.Equals("02") Or QuestionType.Equals("03") Then
Dim ExcelColumnSplitForMultSecond As String()
Dim MultAnswerValue As String
ExcelColumnSplitForMultSecond = ExcelColumnName.Split("_")
MultAnswerValue = AnswerValueRow(0).Item(ExcelColumnNameRaw).ToString.Trim
AnswerValue = ExcelColumnSplitForMultSecond(1).ToString
If MultAnswerValue.Equals("1") Then
QuestionWasAnswer = "1"
ElseIf MultAnswerValue.Equals("2") Then
QuestionWasAnswer = "2"
End If
End If
' Search in the Answers table for the existing AnswerCode
SQLString = String.Format("SELECT Answers.AnswerCode
FROM Answers
WHERE Answers.QuestionCode = '{0}'
AND (Answers.AnswerNumber = '{1}' OR Answers.Answer = '{1}')", QuestionCode, AnswerValue)
AnswerCodeDataTable = SearchInSql(My.Settings.ConnectionString, SQLString)
If AnswerCodeDataTable.Rows.Count > 0 Then
AnswerCode = AnswerCodeDataTable.Rows(0).Item(0).ToString
FormattedDataTable.Rows.Add(ParticipantAnswerCode, ExcelRow.Item(2), QuestionCode, AnswerCode, QuestionWasAnswer, DateRegFinal)
ParticipantAnswerCode = Convert.ToInt32(ParticipantAnswerCode + 1).ToString.PadLeft(ParticipantAnswerCodeFieldLength, "0")
Else
' If a given answer does not exist, save it in the respective table and then try again
Dim AnswerCodeLength = GetLengthFromSqlDataBase(My.Settings.ConnectionString, "Answers", "AnswerCode")
Dim NextAnswerCode = CalculateNextAnswerCode(AnswerCodeLength)
Dim NestAnswerNumber = CalculateNextAnswerNumber(QuestionCode)
SaveNewAnswer(NextAnswerCode, QuestionCode, NestAnswerNumber, AnswerValue)
SQLString = String.Format("SELECT Answers.AnswerCode
FROM Answers
WHERE Answers.QuestionCode = '{0}'
AND Answers.Answer = '{1}'", QuestionCode, AnswerValue)
AnswerCodeDataTable = SearchInSql(My.Settings.ConnectionString, SQLString)
If AnswerCodeDataTable.Rows.Count > 0 Then
AnswerCode = AnswerCodeDataTable.Rows(0).Item(0).ToString
FormattedDataTable.Rows.Add(ParticipantAnswerCode, ExcelRow.Item(2), QuestionCode, AnswerCode, QuestionWasAnswer, DateRegFinal)
ParticipantAnswerCode = Convert.ToInt32(ParticipantAnswerCode + 1).ToString.PadLeft(ParticipantAnswerCodeFieldLength, "0")
End If
End If
End If
End If
End If
Next
Next
Return FormattedDataTable
End Function
After that, I bulk insert the FinalDataTable on the DB.
The problem I am facing:
Using the current program I built, every row in the ExcelDataTable takes about 40 seconds to transform into 300 rows in the FinalDataTable. If I try to load all 4000 rows, it will take more than 40 hours to transform the entire datatable. I need to find a faster way to do this.
As mentioned, there isn't much to go off of on this with what has been provided.
I'm sure there are more helpful fixes to consider but I wanted to put my two cents in about the For Loops.
I recommend switching the
For Each
statements with
For i as integer = 0 to ExcelDataTable.Rows.Count - 1
I've read that For Each is not as performance-friendly as it gathers each "row" as a collection, therefore increasing the overhead per loop.
Here is a SO post about this subject:
Major difference between 'for each' and 'for' loop in .NET
Not sure if that will make a difference for you but thought I would recommend it anyway.

Charting Sales Order stats

I have a datatable that has the columns: Order Number, a count of Lines, and a sum of Units. I want to end up with charts shown here. 3 charts Each shows a column for 1 through 20 and then >20
The problem is looping through the datatable takes over 1.5 minutes.
Dim XAxis(21) As String
Dim LinesPO(21) As Integer 'Lines per Order
Dim UnitsPO(21) As Integer 'Units Per Order
Dim UnitsPL(21) As Integer 'Units Per Line
For Each Dr As DataRow In LivesqlDt2.Rows
For i = 0 To 21
If i < 21 Then
XAxis(i) = i.ToString
If Dr.Item("Lines") = i Then LinesPO(i) += 1
If Dr.Item("Units") = i Then UnitsPO(i) += 1
If Math.Round(Dr.Item("Units") / Dr.Item("Lines"), 0) = i Then UnitsPL(i) += 1
Else
XAxis(i) = ">20"
If Dr.Item("Lines") >= i Then LinesPO(i) += 1
If Dr.Item("Units") >= i Then UnitsPO(i) += 1
If Math.Round(Dr.Item("Units") / Dr.Item("Lines"), 0) >= i Then UnitsPL(i) += 1
End If
Next
Next
I'm looking for any good ideas to speed this up, because the salesman wants to be able to run this in front of their customer.

Adding to every other array position MS Access

I'm needing to take one array (firstArray) and input into a second array (secondArray). However, the first four fields are the same value. After the first four positions, it begins to alternate in values.
Example:
firstArray
+---------+
| ID# |
| Name |
| month1 |
| month2 |
| month3 |
| etc... |
+---------+
secondArray
+----------+
| ID# |
| Name |
| month1 |
| month2 |
| NewField |
| month3 |
| NewField |
| month4 |
| etc... |
+----------+
I'm fairly new to VBA, so I apologize for the awful code.
Code so far:
Dim i As Integer
i = 0
Dim j As Integer
ReDim secondArray(0 To (fieldCount - 4) * 2)
Dim finalCountDown As Integer
finalCountDown = (fieldCount - 4) * 2
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
j = 3
Do Until i > finalCountDown
i = i + 1
secondArray(i) = "NewField"
i = i + 1
j = j + 1
secondArray(i) = firstArray(j)
Loop
I also have a MsgBox to iterate through and output my fields:
'//------ testing output
i = 0
For i = 0 To finalCountDown
MsgBox secondArray(i)
Next i
I appreciate any help! If there's any confusion, I'll gladly try to explain some more!
EDIT:
The two arrays are of different size but are dynamic. firstArray is firstly set to 20 positions while secondArray is originally set to 32 positions. (These are calculated each time this process is ran with the archived data being pulled. This allows my users to add data and not have to worry about having to manually add in the values to my arrays.)
EDIT2:
I've added Erik's portion to my code with a few alterations. I also added a separate counter for my firstArray in order to make sure it's inputting the correct rows into the correct positions of my secondArray.
EDIT3:
Here is the code that ended up working for me:
Dim i As Integer
i = 0
Dim j As Integer
'removed the " - 4"
ReDim secondArray(0 To (fieldCount * 2))
Dim finalCountDown As Integer
'removed the " - 4"
finalCountDown = (fieldCount * 2)
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
'created own counter for firstArray
j = 3
Do Until i > finalCountDown
i = i + 1
secondArray(i) = "NewField"
i = i + 1
j = j + 1
secondArray(i) = firstArray(j)
Loop
The error I was getting was due "Subscript not in Range" due to the fact that my finalCountDown variable was less than my array needed to be. Allowing the variable to become larger than my array allowed my array to finish iterating through itself and now inputs the proper fields in the proper order.
I'm accepting Erik's answer as it was the stepping stone to answering the question!
For the adjusted code, you can do a simple check to check if the j value is valid:
Dim i As Integer
i = 0
Dim j As Integer
ReDim secondArray(0 To (fieldCount - 4) * 2)
Dim finalCountDown As Integer
finalCountDown = (fieldCount - 4) * 2
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
j = 3
Do Until i > finalCountDown
i = i + 1
finalArray(i) = "NewField"
i = i + 1
j = j + 1
If j => LBound(colheaders) And j <= UBound(colHeaders) Then
finalArray(i) = colHeaders(j)
End If
Loop

sorting data by date with excel

I have raw data I'm trying to sort out by date, the data is in this form:
month:april-2014
offer | value
ofr x | 2132
ofr y | 135
.
.
.
month:mai-2014
offer | value
ofr x | 5115
ofr z | 513
ofr y | 651
and it goes on, there are offers that apear every month and others that dissapear.
I wanted it to look like this :
offer | april-2014 |mai 14 | june ....
ofr x 123 5 6
ofr y 5 1 6
ofr z
ofr a
.
.
any help would be appreciated, thank you
Try to restructure the data like this and use pivot tables?
Date | offer | value
may-2014 |ofr x | 5115
may-2014 |ofr z | 513
may-2014 |ofr y | 651
This first chunk of code is going through and rearranging things for you. The other important thing it does is only sends one column from your selected range to the function. Some important things to remember are you may need to write the search criteria if you key word for "month" is not in the same spot in the text, the word offer is not by itself with no spaces in the following row. Another point of note, is this is treating everything as is. That means if the source cell was text, then the destination cell will be text. To convert from date as text to date as Excel serial that is a separate issue and there are plenty of ways to achieve that as well.
Option Explicit
Sub SortOffer(OfferList As Range)
Dim CounterX As Long, CounterY As Long, jCounter As Long, icounter As Long, MonthCount As Long, UniqueOffers As Long
Dim inlist As Boolean
Dim unsorted() As Variant
Dim sorted() As Variant
MonthCount = WorksheetFunction.CountIf(OfferList, "month*")
UniqueOffers = CountUnique(OfferList.Columns(1).Cells) - MonthCount - 1
ReDim sorted(1 To UniqueOffers + 1, 1 To MonthCount + 1) As Variant
unsorted = OfferList
CounterX = 1
jCounter = 1
sorted(1, 1) = "offer"
For CounterY = LBound(unsorted, 1) To UBound(unsorted, 1)
If Left(unsorted(CounterY, 1), 5) = "month" Then
CounterX = CounterX + 1
sorted(1, CounterX) = Right(unsorted(CounterY, 1), Len(unsorted(CounterY, 1)) - 6)
Else
inlist = False
For icounter = 2 To jCounter
If unsorted(CounterY, 1) = sorted(icounter, 1) Then
sorted(icounter, CounterX) = unsorted(CounterY, 2)
inlist = True
End If
Next icounter
If Not inlist And unsorted(CounterY, 1) <> "offer" And unsorted(CounterY, 1) <> "" Then
jCounter = jCounter + 1
sorted(jCounter, 1) = unsorted(CounterY, 1)
sorted(jCounter, CounterX) = unsorted(CounterY, 2)
End If
End If
Next CounterY
Range("F1").Resize(UBound(sorted, 1), UBound(sorted, 2)).Value = sorted
End Sub
This next function counts the number of unique entries in a range and does not count spaces. I stumbled across this code on this web page. If you subtract the number of months from this count, you will know how many offers are in your table. This is important because it will tell you how to size your array(alt link) that you will later write back as your results
Function CountUnique(ByVal MyRange As Range) As Integer
Dim Cell As Range
Dim J As Integer
Dim iNumCells As Integer
Dim iUVals As Integer
Dim sUCells() As String
iNumCells = MyRange.Count
ReDim sUCells(iNumCells) As String
iUVals = 0
For Each Cell In MyRange
If Cell.Text > "" Then
For J = 1 To iUVals
If sUCells(J) = Cell.Text Then
Exit For
End If
Next J
If J > iUVals Then
iUVals = iUVals + 1
sUCells(iUVals) = Cell.Text
End If
End If
Next Cell
CountUnique = iUVals
End Function
Now just in case the links don't cover it, this answer which was a learning lesson for me was taught in various parts to me by #JNevill, #Ralph, #findwindow, #Gary'sStudent and #ScottCraner. Appologies if I missed someone. I am also sure any of these individuals could do it slicker and take less then 10 hours to write it 8).

Date countdown on gridview

I am trying to countdown the date from today's date on a gridview, so it shows the last 60 days.
I have wrote the code like this but it doesn't work:
Private Sub BindGrid()
Dim dt As New DataTable
dt.Columns.Add("Date")
dt.Columns.Add("TallyCount")
dt.Columns.Add("AcceptedCount")
gvTally.DataSource = dt
Dim dr As DataRow
Dim DateCount As Integer = 1
Dim DateNow As Date = DateTime.Today
For j As Integer = DateCount To 60
dr = dt.NewRow
DateNow = DateNow.AddDays(-j)
dr.Item("Date") = DateNow.ToString("MM/dd/yyyy")
dr.Item("TallyCount") = 1
dr.Item("AcceptedCount") = 2
dt.Rows.Add(dr)
Next
gvTally.DataSource = dt
gvTally.DataBind()
End Sub
The date will randomly jump numbers from 6/02/2015 to like 5/27/2015.
1 2 06/16/2015
1 2 06/14/2015
1 2 06/11/2015
1 2 06/07/2015
1 2 06/02/2015
1 2 05/27/2015
1 2 05/20/2015
1 2 05/12/2015
1 2 05/03/2015
1 2 04/23/2015
1 2 04/12/2015
1 2 03/31/2015
1 2 03/18/2015
1 2 03/04/2015
1 2 02/17/2015
1 2 02/01/2015
What am I doing wrong?
You are using a loop. So examine the code:
Dim DateNow As Date = DateTime.Today
For j As Integer = DateCount To 60
dr = dt.NewRow
DateNow = DateNow.AddDays(-j)
First time, it will deduct 1 from today, next time -2 from that, then -3 from that; at the third iteration it has deducted 6 total (3+2+1) . Change it to:
DateNow = DateNow.AddDays(-1)
Now, it will deduct one day per iteration.