VBA Code returns "Error 6' Overflow error when array element is greater than 1010

mtenorio

New Member
Joined
Sep 5, 2014
Messages
18
Hello Guys!

I am having a problem with my code below. This code extracts data from a text file.
The part where the error occurs is on the 'Converts the quantity from string to integer data type
part of the code.

It returns an overflow error. It works fine for text files with lines up to 1010, but greater than that the error happens.

Do you guys have ideas to resolve this? I have declared the data type as LONG already...

Thanks to your help!!!!





Code:
Sub generate_report()

'Reads the S file per line, extract the product names and quantity then gets the top 10 for the current & previous month

Dim stext_current() As String, stext_previous() As String
Dim row_number As Integer, LineFromFile As String
Dim a As String, b As String, c As String, d As String, file_current As String, file_previous As String
Dim product_current As String, quantity_current As String, quantity_m2 As String
Dim product_previous As String, quantity_previous As String
Dim product_current_all As String, quantity_current_all As String, snumber_current() As String, quantity_m2_all As String
Dim product_previous_all As String, quantity_previous_all As String, snumber_previous() As String, snumber_m2() As String
Dim SrtTemp_current() As Long, top10_current(1 To 10) As Long, SrtTemp_m2() As Long
Dim SrtTemp_previous() As Long, top10_previous(1 To 10) As Long
Dim sum_current As Long, sum_previous As Long, sum_month2 As Long, sum_month3 As Long, sum_m12 As Long
Dim period_m2 As String, period_m3 As String, period_m12 As String
Dim quantity_m3 As String, quantity_m3_all As String, snumber_m3() As String, SrtTemp_m3() As Long
Dim quantity_m12 As String, quantity_m12_all As String, snumber_m12() As String, SrtTemp_m12() As Long
Dim I As Long
Dim j As Long
Dim k As Long
Dim l As Long

a = "\\parsfil01\Databases\bases\Hopital\LMH_CDF"                     'static location of the files
b = Worksheets("Sheet1").Range("C6:C6").Value                           'gets the value of the supplier code
c = Worksheets("Sheet1").Range("C8:C8").Value                           'gets the value of the current period
d = Worksheets("Sheet1").Range("C10:C10").Value                         'gets the value of the previous period
period_m2 = (WorksheetFunction.VLookup(Left(c, 2), Range("P2:U13"), 4)) & Right(c, 2)
period_m3 = (WorksheetFunction.VLookup(Left(c, 2), Range("P2:U13"), 5)) & Right(c, 2)
period_m12 = (WorksheetFunction.VLookup(Left(c, 2), Range("P2:U13"), 6)) & Range("O2")
'MsgBox FileNameCurrent(a, c, b)

Sheets("Sheet1").Select
ActiveSheet.Unprotect

'Code for the current month
If FileName(a, c, b) = "" Then
    Range("H7").Value = "N/A"
    MsgBox "There is no file found for the current month."
Else
    Open FileName(a, c, b) For Input As #1                            'opens the sales file for the current month
    row_number = 0
    Do Until EOF(1)                                                          'reads the text line per line until the end of file
        Line Input #1, LineFromFile
        product_current = Mid(LineFromFile, 104, 80)                         'extracts the product name
        quantity_current = Mid(LineFromFile, 237, 10)                        'extracts the quantity
        product_current_all = product_current_all & product_current & ";"    'stores the product name into an delimited array
        quantity_current_all = quantity_current_all & quantity_current & ";" 'stores the quantity into an delimited array
        row_number = row_number + 1
    Loop
    Close #1
    
    'Splits the delimited array
    stext_current() = Split(product_current_all, ";")
    snumber_current() = Split(quantity_current_all, ";")
    
    'Converts the quantity from string to integer data type
    For I = LBound(snumber_current) + 1 To UBound(snumber_current) - 2
        ReDim Preserve SrtTemp_current(I)
            'MsgBox snumber_current(I)
            [B]SrtTemp_current(I) = CInt(snumber_current(I))[/B]            
            Debug.Print TypeName(SrtTemp_current(I))
            'MsgBox SrtTemp(I)
    Next I
    
    'Sums the quantity
    Range("H7").Value = WorksheetFunction.Sum(SrtTemp_current())
    
    'Gets the top 10
    top10_current(1) = WorksheetFunction.Large(SrtTemp_current(), 1)
    top10_current(2) = WorksheetFunction.Large(SrtTemp_current(), 2)
    top10_current(3) = WorksheetFunction.Large(SrtTemp_current(), 3)
    top10_current(4) = WorksheetFunction.Large(SrtTemp_current(), 4)
    top10_current(5) = WorksheetFunction.Large(SrtTemp_current(), 5)
    top10_current(6) = WorksheetFunction.Large(SrtTemp_current(), 6)
    top10_current(7) = WorksheetFunction.Large(SrtTemp_current(), 7)
    top10_current(8) = WorksheetFunction.Large(SrtTemp_current(), 8)
    top10_current(9) = WorksheetFunction.Large(SrtTemp_current(), 9)
    top10_current(10) = WorksheetFunction.Large(SrtTemp_current(), 10)
    
    'Places the top 10 on the excel sheet
    Range("I12").Value = top10_current(1)
    Range("I13").Value = top10_current(2)
    Range("I14").Value = top10_current(3)
    Range("I15").Value = top10_current(4)
    Range("I16").Value = top10_current(5)
    Range("I17").Value = top10_current(6)
    Range("I18").Value = top10_current(7)
    Range("I19").Value = top10_current(8)
    Range("I20").Value = top10_current(9)
    Range("I21").Value = top10_current(10)
    
    'Gets the product name for the top 10 quantities
    For l = 1 To 10
        For k = LBound(SrtTemp_current()) To UBound(SrtTemp_current())
            If top10_current(l) = SrtTemp_current(k) Then
                Worksheets("Sheet1").Activate
                Range("F" & l + 11).Value = stext_current(k)
            Else
            End If
        Next k
    Next l
End If
End sub
 
Last edited:

VoG

Legend
Joined
Jun 19, 2002
Messages
63,651
Try

Rich (BB code):
SrtTemp_current(I) = CLng(snumber_current(I))
 

Forum statistics

Threads
1,081,617
Messages
5,360,049
Members
400,565
Latest member
Tommy O

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top