I have the following code:
I am getting the error in counts.Item(value) = 1.
Set xmlNodeList = xmlEncounter.documentElement.selectNodes("//BillingLIne/Receipts")
If xmlNodeList.length > 1 Then
For i_Loop1 = 1 To xmlNodeList.length
strserviceChecked_GL(i_Loop1) = xmlNodeList.Item(i_Loop1 - 1).Attributes.getNamedItem("ServiceID").nodeValue
Id1tobechecked_GL(i_Loop1) = xmlNodeList.Item(i_Loop1 - 1).Attributes.getNamedItem("Receptid1").nodeValue
Id2tobechecked_GL(i_Loop1) = xmlNodeList.Item(i_Loop1 - 1).Attributes.getNamedItem("Receptid2").nodeValue
Id3tobechecked_GL(i_Loop1) = xmlNodeList.Item(i_Loop1 - 1).Attributes.getNamedItem("Receptid3").nodeValue
Id4tobechecked_GL(i_Loop1) = xmlNodeList.Item(i_Loop1 - 1).Attributes.getNamedItem("Receptid4").nodeValue
Next i_Loop1
End If
Dim value As Variant
Dim counts As Collection
Set counts = New Collection
For Each value In strserviceChecked_GL
If Not Exists(counts,value) Then
counts.Item(value) = 1
Else
counts.Item(value) = counts.Item(value) + 1
End If
Next
Public Function Exists(ByVal oCol As Collection, ByVal vKey As Variant) As Boolean
On Error Resume Next
oCol.Item vKey
Exists = (Err.Number = 0)
Err.Clear
End Function
When a collection has no item for a key, you need to add one, and give it a value as follows.
For Each value In strserviceChecked_GL
If Not Exists(counts,value) Then
' Key 'value' is not in 'counts' collection.
' Add key 'value', and give it the value 1.
counts.Add 1, CStr(value)
'counts.Item(value) = 1
Else
counts.Item(value) = counts.Item(value) + 1
End If
Next
Related
I have this code to access:
Option Compare Database
Public Sub batchAdd(records As Integer)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("tblMeters")
i = 1
Do While i <= records
rs.AddNew
rs!value1 = Me.value1
rs!Ticket = Me.Ticket
rs!value2 = Me.value2
rs!value3 = Me.value3
rs!value4 = Me.value4
rs!value5 = Me.value5
rs!value6 = Me.value6
rs!value7 = Me.value7
rs.Update
i = i + 1
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Sub cmdAddRecords_Click()
batchAdd Me.txtRecords
Me.tblMeters_sub.Requery
End Sub
My question was how to increase the ticket value of +1 for each record inserted.
Example: If I insert the ticket with a value of 1 to 10 times, the first time will be 1 and the second 2, then 3 .... how do I change this code for the ticket value?
Adjust this line to:
rs!Ticket = i
I'm trying to build a datatable and then bind it to a gridview and chart object. The gridview appears fine but when I build the x,y array and bind them to the chart object I get the error above.
I've read many forums to understand that the index is looking at a field that is out of range but I've queried in the immediate window all the fields and the are clearly values there. There error occurs as soon as I bind it to the chart object and I don't know why the chart object doesn't just display properly.
This is my aspx codebehind:
Dim dt As DataTable = New DataTable()
dt.Columns.Add("CompanyName")
dt.Columns.Add("Amount")
dt.Columns.Add("Proportion")
Using DBContext As New fundmatrixEntities
Dim queryUnits = (From c In DBContext.Units Where c.SavingApplicationId = savAppId Select New With {.LoanAppId = c.LoanApplicationId}).Distinct().ToList()
Dim companyName As String = ""
Dim savingsAmount As String = ""
Dim totalProportion As String = ""
Dim totalSavingsAmount As String = ""
For Each loan In queryUnits
If Not loan.LoanAppId Is Nothing Then
companyName = classSQLDirect.ExecQuery("SELECT companyname FROM companyprofile where loanapplicationid='" & loan.LoanAppId.ToString & "'")
savingsAmount = classSQLDirect.ExecQuery("SELECT SUM(Amount) from unit where SavingApplicationId='" & savAppId.ToString & "' and LoanApplicationId='" & loan.LoanAppId.ToString & "'")
totalSavingsAmount = classSQLDirect.ExecQuery("SELECT amount FROM SavingApplication WHERE SavingApplicationId='" & savAppId.ToString & "'")
totalProportion = ((savingsAmount / totalSavingsAmount) * 100) & "%"
dt.Rows.Add(companyName, savingsAmount, totalProportion)
End If
Next
gvwBusinesses.DataSource = dt
gvwBusinesses.DataBind()
End Using
Dim x As String() = New String(dt.Rows.Count - 1) {}
Dim y As String() = New String(dt.Rows.Count - 1) {}
For i As Integer = 0 To dt.Rows.Count - 1
x(i) = dt.Rows(i)(0).ToString()
y(i) = dt.Rows(i)(2).ToString()
Next
chart1.Series(0).Points.DataBindXY(x, y)
chart1.Series(0).ChartType = SeriesChartType.Pie
The code errors on the line
chart1.Series(0).Points.DataBindXY(x, y)
I have a recursive function that creates a list of items based on their hierarchy(integer is used to determine which level 1 to 10 max). There can be x number of items in any given level. I want to store all the items that belong the same level at the corresponding index of the jagged array. The items aren't retrieved based on their level so the level can be jumping around all of over the place as the function recurses.
Function RecurseParts(lngPartID1, lngLevel) As Object
'this function will recursivley print the parts lists for the part ID passed in
If IsNumeric(lngPartID1 & "") Then
Dim objRSTemp As Object = Server.CreateObject("ADODB.Recordset")
objRSTemp.CursorLocation = adUseClient
objRSTemp.Open(PART_LIST_SQL & lngPartID1, objConn, adOpenForwardOnly, adLockReadOnly)
'objRSTemp.ActiveConnection = Nothing
If objRSTemp.eof And objRSTemp.bof Then
'PROBLEM, WE HAVE NO RECORDS
Response.Write("There Were No Parts For This Assembly (Part ID #:" & lngPartID1 & ")")
Else
'make output
Dim strTemp As String = String.Empty
If lngLevel <> 1 Then strTemp = " style=""display: none;"">"
Response.Write("<table id='tblparts" & lngCurrentLineNum & "' border=""0"" cellspacing=""0"" width=""100%"" cellpadding=""1"" " & strTemp)
Do Until objRSTemp.EOF
'increase the current line num
lngCurrentLineNum = lngCurrentLineNum + 1
'get current Part ID
lngCurrentPartID = objRSTemp("PartID").value
'reset flag
blnIsAssm = False
'loop thru array of assemblies to see if this is a parent
For ctr = 0 To UBound(arrAssmList, 2)
If arrAssmList(0, ctr) = lngCurrentPartID Then
'the current part is an assembly
blnIsAssm = True
Exit For
ElseIf arrAssmList(0, ctr) > lngCurrentPartID Then
Exit For
End If
Next
If blnIsAssm Then
'recurse these parts
If RecurseParts(objRSTemp("PartID").value, lngLevel + 1) = True Then
'awesome
End If
End If
objRSTemp.MoveNext()
Loop
Response.Write("</table>")
End If
If objRSTemp.State Then objRSTemp.Close()
objRSTemp = Nothing
'RETURN FUNCTION
RecurseParts = True
Else
'no PART ID passed in
Response.Write("No Part ID Passed In")
RecurseParts = False
End If
End Function
It sounds like a Dictionary would work here.
Dim myDict As New Dictionary(Of Integer, List(Of String))
In your recursive function. The parts in the {} are the parts you have to supply.
'this builds the keys as you go
If Not myDict.ContainsKey({{key} -> your Integer}) Then
'add key and use the From statement to add a value if know at this time
myDict.Add({key}, New List(Of String) From {value})
Else
myDict({key}).Add({string to insert at this level})
End If
List of keys in reverse order:
Dim keys = myDict.Keys.OrderByDescending(Function(k) k)
I was able to create a List to store all the partIDs and their levels.
Dim arrSubID As New List(Of List(Of Integer))()
Function RecurseParts(paramenters)
For ctr = 0 To UBound(arrAssmList, 2)
If arrAssmList(0, ctr) = lngCurrentPartID Then
'checks whether we need a new index in the list
If lngLevel + 1 > arrSubID.Count Then
arrSubID.Add(New List(Of Integer))
End If
'adds the partID where it belongs!
arrSubID(lngLevel).Add(lngCurrentPartID)
blnIsAssm = True
Exit For
ElseIf arrAssmList(0, ctr) > lngCurrentPartID Then
Exit For
End If
Next
End Function
i'm using vb.net i have the following object array that i'm trung to extract all the true value from give it a name and add it to an array
here is the object array
this is what i have tried so far :
Dim myarray() As String
Dim number As Integer = 0
If resultArray(0).BolComment Then
myarray(number) = "comment"
number = number + 1
End If
If resultArray(0).BolComplete Then
myarray(number) = "complete"
number = number + 1
End If
If resultArray(0).BolFinished Then
myarray(number) = "Finished"
number = number + 1
End If
If resultArray(0).BolOutCome Then
myarray(number) = "OutCome"
number = number + 1
End If
If resultArray(0).BolStatred Then
myarray(number) = "Started"
number = number + 1
End If
If resultArray(0).BolUser Then
myarray(number) = "User"
number = number + 1
End If
this is giving me an error : the variable has been used before
Question how can i extract all the items that have the true value and push it to a new array with giving it a new name
Thanks
I think your problem is that you are not initializing the array to a specific size, nor are you re-sizing it each time you add a new item. However, it would be better to just use the List(T) class:
Dim list As New List(Of String)()
If resultArray(x).BolComment Then
list.Add("comment")
End If
If resultArray(0).BolComplete Then
list.Add("complete")
End If
If resultArray(0).BolFinished Then
list.Add("Finished")
End If
If resultArray(0).BolOutCome Then
list.Add("OutCome")
End If
If resultArray(0).BolStatred Then
list.Add("Started")
End If
If resultArray(0).BolUser Then
list.Add("User")
End If
Then, if you need it as an actual array, do this:
Dim myarray() As String = list.ToArray()
I have a shopping cart that using 2d array Cart(3, 20) to store user shop in a session.
It storing data like this:
Cart(0,0) = Product_ID
Cart(1,0) = Product_Name
Cart(2,0) = Product_Price
Cart(3,0) = Product_Qty
I want to count Items based on product_id ( we have not repetitive product_id)
I found a function here:
Function UniqueEntryCount(SourceRange)
Dim MyDataset
Dim dic
Set dic=Server.CreateObject("Scripting.Dictionary")
MyDataset = SourceRange
For i = 1 To UBound(MyDataset, 2)
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
Next
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
But one problem is remain, When my Cart is empty, it show me 1
How can solved it?
An unitialized fixed array (Dim a(i, j)) contains i * j empty elements; your
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
will pick up and count the first empty item. Demonstrated in code:
Dim afCart(3, 4)
Dim dicPID : Set dicPID = countPID00(afCart)
Dim aKeys : aKeys = dicPID.Keys
Dim vKey : vKey = aKeys(0)
WScript.Echo "A", dicPID.Count, TypeName(vKey)
Set dicPID = countPID(afCart)
WScript.Echo "B", dicPID.Count
afCart(0, 0) = "ignored"
afCart(0, 1) = 4711
afCart(0, 2) = 4712
afCart(0, 3) = 4711
' afCart(0, 4) = "not initialized/Empty"
Set dicPID = countPID(afCart)
WScript.Echo "C"
For Each vKey In dicPID.Keys
WScript.Echo "", vKey, "=", dicPID(vKey)
Next
Function countPID00(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim MyDataset : MyDataset = afCart ' waste of ressources
Dim iRow
For iRow = 1 To UBound(MyDataset, 2)
If Not dicRVal.Exists(MyDataset(0, iRow)) Then
dicRVal(MyDataset(0, iRow)) = "" ' loss of info; will pick up Empty item
End If
Next
Set countPID00 = dicRVal
End Function ' countPID00
Function countPID(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim iRow
For iRow = 1 To UBound(afCart, 2)
If Not IsEmpty(afCart(0, iRow)) Then
dicRVal(afCart(0, iRow)) = dicRVal(afCart(0, iRow)) + 1
End If
Next
Set countPID = dicRVal
End Function ' countPID
output:
A 1 Empty
B 0
C
4711 = 2
4712 = 1