I would like create a macro (VBA) that find a word and in another cell give a word.
Example:
|A | B | macro result|
|--|-----------------------|-------------|
|1 |my cat is on the table | ok |
|2 |Hi | |
|3 |this is my house | ok |
I have try this but it doesn't work. Can you help me?
Sub Macro1()
riga = 1
While (Sheets("Foglio2").Cells(riga, 1) <> "")
If (Sheets("Foglio2").Cells(riga, 2) Like "my") Then
Sheets("Foglio2").Cells(riga, 3) = "ok"
End If
riga = riga + 1
Wend
End Sub
Sub Macro1()
riga = 1
While (Sheets("Foglio2").Cells(riga, 1) <> "")
If Instr(Sheets("Foglio2").Cells(riga, 2), "my") > 0 Then
Sheets("Foglio2").Cells(riga, 3) = "ok"
End If
riga = riga + 1
Wend
End Sub
Related
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.
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
I am trying to create a UserForm in Excel 2010/2013 that will look through a list of items and return a complete list based on a number I provide.
Here's what the list would look like: See Example (image hosted on Imgur)
A Here's a snippit in case the image won't load...
Location ----- Title ----- Days Past
A2: 0001 | B2: Movie 1 | C2: 32
A3: 0001 | B3: Movie 2 | C3: 18
A4: 0001 | B4: Movie 3 | C4: 10
A5: 0004 | B5: Movie 1 | C5: 32
A6: 0007 | B6: Movie 1 | C6: 32
A7: 0007 | B7: Movie 2 | C7: 18
A8: 0009 | B8: Movie 1 | C8: 32
A9: 0014 | B9: Movie 1 | C9: 32
I have a userform that will return the first item in the list, but not the complete list. Ideally I would like to stay away from using a list box, mainly because the goal is to be able to copy the items in the full list.
I have tried the Index() formula but I don't know how to transfer that to work in VBA.
Any help you have would be great!
I have written this for you, which if your location values are given in the A column, Titles in the B and Days Past in the C this should work:
Private Sub SUBMITBUTTON_Click()
Dim counter As Integer, TITLELIST(), DAYSPAST(), fullString As String
fullString = ""
If LOCATIONTEXTBOX.Text = "" Then
MsgBox "Please input a location"
Exit Sub
End If
For Each Cell In ActiveSheet.UsedRange.Cells
If Cell.Value = LOCATIONTEXTBOX.Text Then
counter = counter + 1
End If
Next
ReDim TITLELIST(counter)
ReDim DAYSPAST(counter)
counter = 0
For i = 1 To Cells(1, 1).End(xlDown).Row
If Cells(1, i).Value = LOCATIONTEXTBOX.Text Then
TITLELIST(counter) = Cells(i, 2).Value
DAYSPAST(counter) = Cells(i, 3).Value
fullString = fullString & CStr(TITLELIST(counter)) & "," & CStr(DAYSPAST(counter)) & ","
counter = counter + 1
End If
Next
MsgBox fullString
Range("H8").Value = fullString
End Sub
If you change the names of SUBMITBUTTON and LOCATIONTEXTBOX then it should work in your userform.
I have an issue with Access 2010.
I use transaction to encapsulate my modification in a form. This transaction is started in the Form_Load() sub.
Private Sub Form_Load()
Debug.Print "Right here"
DAO.DBEngine.Workspaces(0).BeginTrans
Debug.Print "Here too"
...
End Sub
So the transaction is started at the very first line (nothing else is running before, the Debug.Print are just here to show you the code run through the line).
When I click on the button "save" or "rollback", I run some code like this :
Private Sub BtnSauvegarder_Click()
DAO.DBEngine.Workspaces(0).CommitTrans dbForceOSFlush
DoCmd.OpenForm "F_ListeDemande", acNormal, , , acFormEdit, acWindowNormal
DoCmd.Close acForm, Me.name
End Sub
And that's here I got the error 3034, both in save or rollback code (which are similar)
BUT, the weirdest thing is here : when I entered the form, my Listbox are bugy, nothing are inside. If I entered in Design view, do nothing and then entered in the Normal view, everything run right : Listbox have the Recordset they are supposed to have and the transaction work fine.
This is not the first time I use transaction, I used the same way on other forms without any problem.
So what I am doing wrong ?
EDIT :
I made this code to output the current state of DAO.DBEngine, in case it is useful.
Public Sub DebugDBEngine()
Dim ws As Workspace
Dim db As Database
Dim p As Property
For Each ws In DAO.DBEngine.Workspaces
Debug.Print "Workspace : " & ws.name
For Each p In ws.Properties
On Error Resume Next
Debug.Print "| " & p.name & " = " & p.value
Next
For Each db In ws.Databases
Debug.Print "| Database : " & db.name
For Each p In db.Properties
On Error Resume Next
Debug.Print "| | " & p.name & " = " & p.value
Next
Next
Next
End Sub
So I use it just after the beginning of the transaction and the output is this :
Workspace : #Default Workspace#
| Name = #Default Workspace#
| UserName = admin
| IsolateODBCTrans = 0
| Type = 2
| Database : H:\Projet\05\15\10h28 - Suivi commande et fournisseur.accdb
| | Name = H:\Projet\05\15\10h28 - Suivi commande et fournisseur.accdb
| | Connect =
| | Transactions = True
| | Updatable = True
| | CollatingOrder = 1036
| | QueryTimeout = 60
| | Version = 14.0
| | RecordsAffected = 0
| | ReplicaID =
| | DesignMasterID =
| | ANSI Query Mode = 0
| | Themed Form Controls = 1
| | AccessVersion = 09.50
| | NavPane Category = 0
| | UseMDIMode = 0
| | ShowDocumentTabs = True
| | Build = 24
| | HasOfflineLists = 70
| | Picture Property Storage Format = 0
| | CheckTruncatedNumFields = 1
| | ProjVer = 119
| | NavPane Closed = 0
| | NavPane Width = 226
| | NavPane View By = 0
| | NavPane Sort By = 1
| | Show Navigation Pane Search Bar = 0
| | WebDesignMode = 0
| | Theme Resource Name = Thème Office
| | Property Sheet Label Width = 2820
| | StartUpShowDBWindow = True
| | StartUpShowStatusBar = True
| | AllowShortcutMenus = True
| | AllowFullMenus = True
| | AllowBuiltInToolbars = True
| | AllowToolbarChanges = True
| | AllowSpecialKeys = True
| | UseAppIconForFrmRpt = False
| | AllowDatasheetSchema = True
| | DesignWithData = True
| | Show Values Limit = 1000
| | Show Values in Indexed = 1
| | Show Values in Non-Indexed = 1
| | Show Values in Remote = 0
| | Auto Compact = 0
| | Track Name AutoCorrect Info = 0
| Database : H:\Projet\05\15\10h28 - Suivi commande et fournisseur.accdb
| |(same things as above, it is the same database)
So, the same DB is open twice. I verify : where the transactions are correctly runing, only one DB is open.
EDIT2 :
I tested again with this debug to enter in normal view, then design and then normal. The first time, I've got the output just above. The second time, it is the same without the second same database, there is juste one DB.
So now, I'm sure the problem is they are two databases opened. All I have to find is WHY it open twice the same DB.
With hard searching, I probably found the problem.
In Design view, I set to Listboxes some query to fill them. It use one database to do it.
In my VBA code, I use Recordset to fill the Listboxes. And they use another database, even if it is the same.
So my solution is simple : I don't define the rowsource in Design view, so only the VBA will fill the Listboxes.
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