H
Hilton
Ok, so I have been told that loading all records into an array is not smart!
However I need to add 2 extra dimensions to the array.
Can someone please fix?
Note Input file has about 8 million records and growing each month!
I need to add a portfolio which has 750 unqiue elements
I need to add a product which has 25 unique elements
=======================================================
Here is sample code:
Sub Button5_Click()
Dim strLine As String
Dim strAcc As String
Dim strBu As String
Dim strNP As String
Dim lngStatus As Long
Dim lngCnt As Long
Dim lngPremium As Long
Dim sPremium As Single
Dim intcounter As Integer
Dim NewArray(1200, 8)
Dim BuArray(10)
Dim blnFound As Boolean
Dim intUniqueItems As Integer: intUniqueItems = 0
Open "c:\movtin.pro" For Input As #1
Open "c:\movtout.txt" For Output As #2
Line Input #1, strLine 'header line
p = 2
Do Until EOF(1)
polval2 = polval1
Line Input #1, strLine
strAcc = Mid$(strLine, 33, 1)
strBu = Mid$(strLine, 3, 2)
txtstr = Mid$(strLine, 46, 16)
strNP = Mid$(strLine, 472, 1)
lngStatus = CLng(Mid$(strLine, 97, 1))
lngCnt = 1
lngPremium = CLng(Mid$(strLine, 283, 9))
sPremium = CLng(Mid$(strLine, 266, 9))
For m = LBound(BuArray, 1) To UBound(BuArray, 1)
BuArray(m) = strBu
Next
n = 0
Select Case (BuArray(n))
Case (BuArray(n))
blnFound = False
For intcounter = LBound(NewArray, 1) To UBound(NewArray, 1)
If NewArray(intcounter, 1) = strAcc And NewArray(intcounter, 2) =
strBu And NewArray(intcounter, 3) = txtStr And NewArray(intcounter, 4) =
strNP And NewArray(intcounter, 5) = lngStatus Then
NewArray(intcounter, 6) = CLng(NewArray(intcounter, 6)) +
lngPremium
NewArray(intcounter, 7) = NewArray(intcounter, 7) + sPremium
NewArray(intcounter, 8) = CLng(NewArray(intcounter, 8)) + 1
blnFound = True
End If
Next
If Not blnFound Then
intUniqueItems = intUniqueItems + 1
intAcc = strAcc
NewArray(intUniqueItems, 1) = strAcc
NewArray(intUniqueItems, 2) = strBu
NewArray(intUniqueItems, 3) = txtstr
NewArray(intUniqueItems, 4) = strNP
NewArray(intUniqueItems, 5) = lngStatus
NewArray(intUniqueItems, 6) = lngPremium
NewArray(intUniqueItems, 7) = sPremium
NewArray(intUniqueItems, 8) = lngCnt
End If
End Select
n = n + 1
p = p + 1
Loop
Print #2, "Ind" & "," & "BU" & "," & "Trx_Name" & "," & "Status" & "NPSale"
"," & "Prem" & ","; "SPrem" & "," & "Count"
For intcounter = 1 To 1200
If NewArray(intcounter, 1) & vbNullString <> vbNullString Then
Print #2, NewArray(intcounter, 1) & "," & NewArray(intcounter, 2) &
"," & NewArray(intcounter, 3) & "," & NewArray(intcounter, 3) & "," &
NewArray(intcounter, 4) & "," & NewArray(intcounter, 5) & "," &
NewArray(intcounter, 6) & "," & NewArray(intcounter, 7) & "," &
NewArray(intcounter, 8)
End If
Next intcounter
Close #1
Close #2
MsgBox ("Recs processed: ") + Str(p - 1)
MsgBox ("End of run!")
End Sub
However I need to add 2 extra dimensions to the array.
Can someone please fix?
Note Input file has about 8 million records and growing each month!
I need to add a portfolio which has 750 unqiue elements
I need to add a product which has 25 unique elements
=======================================================
Here is sample code:
Sub Button5_Click()
Dim strLine As String
Dim strAcc As String
Dim strBu As String
Dim strNP As String
Dim lngStatus As Long
Dim lngCnt As Long
Dim lngPremium As Long
Dim sPremium As Single
Dim intcounter As Integer
Dim NewArray(1200, 8)
Dim BuArray(10)
Dim blnFound As Boolean
Dim intUniqueItems As Integer: intUniqueItems = 0
Open "c:\movtin.pro" For Input As #1
Open "c:\movtout.txt" For Output As #2
Line Input #1, strLine 'header line
p = 2
Do Until EOF(1)
polval2 = polval1
Line Input #1, strLine
strAcc = Mid$(strLine, 33, 1)
strBu = Mid$(strLine, 3, 2)
txtstr = Mid$(strLine, 46, 16)
strNP = Mid$(strLine, 472, 1)
lngStatus = CLng(Mid$(strLine, 97, 1))
lngCnt = 1
lngPremium = CLng(Mid$(strLine, 283, 9))
sPremium = CLng(Mid$(strLine, 266, 9))
For m = LBound(BuArray, 1) To UBound(BuArray, 1)
BuArray(m) = strBu
Next
n = 0
Select Case (BuArray(n))
Case (BuArray(n))
blnFound = False
For intcounter = LBound(NewArray, 1) To UBound(NewArray, 1)
If NewArray(intcounter, 1) = strAcc And NewArray(intcounter, 2) =
strBu And NewArray(intcounter, 3) = txtStr And NewArray(intcounter, 4) =
strNP And NewArray(intcounter, 5) = lngStatus Then
NewArray(intcounter, 6) = CLng(NewArray(intcounter, 6)) +
lngPremium
NewArray(intcounter, 7) = NewArray(intcounter, 7) + sPremium
NewArray(intcounter, 8) = CLng(NewArray(intcounter, 8)) + 1
blnFound = True
End If
Next
If Not blnFound Then
intUniqueItems = intUniqueItems + 1
intAcc = strAcc
NewArray(intUniqueItems, 1) = strAcc
NewArray(intUniqueItems, 2) = strBu
NewArray(intUniqueItems, 3) = txtstr
NewArray(intUniqueItems, 4) = strNP
NewArray(intUniqueItems, 5) = lngStatus
NewArray(intUniqueItems, 6) = lngPremium
NewArray(intUniqueItems, 7) = sPremium
NewArray(intUniqueItems, 8) = lngCnt
End If
End Select
n = n + 1
p = p + 1
Loop
Print #2, "Ind" & "," & "BU" & "," & "Trx_Name" & "," & "Status" & "NPSale"
"," & "Prem" & ","; "SPrem" & "," & "Count"
For intcounter = 1 To 1200
If NewArray(intcounter, 1) & vbNullString <> vbNullString Then
Print #2, NewArray(intcounter, 1) & "," & NewArray(intcounter, 2) &
"," & NewArray(intcounter, 3) & "," & NewArray(intcounter, 3) & "," &
NewArray(intcounter, 4) & "," & NewArray(intcounter, 5) & "," &
NewArray(intcounter, 6) & "," & NewArray(intcounter, 7) & "," &
NewArray(intcounter, 8)
End If
Next intcounter
Close #1
Close #2
MsgBox ("Recs processed: ") + Str(p - 1)
MsgBox ("End of run!")
End Sub