ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Sample code to be fixed! (https://www.excelbanter.com/excel-discussion-misc-queries/204629-sample-code-fixed.html)

Hilton

Sample code to be fixed!
 
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




All times are GMT +1. The time now is 11:21 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com