Consulting

Results 1 to 7 of 7

Thread: Help?! Run-time error 6 overflow

  1. #1

    Help?! Run-time error 6 overflow

    Hi all,
    I seek help to fix the below coding... I took over this spreadsheet from a former colleague. It was running smoothly for the past 3 months until now. Nothing has changed, in the files nor the code.
    The error Run-time error 6 overflow comes up on the highlighted part of the code below and I am not sure how to fix it. Someone please help? MUCH appreciated!!!

    Sub Output() 'Exporter
    
    Dim thisWB As Workbook
    Dim opWB As Workbook
    Dim autoWS As Worksheet
    Dim opWS As Worksheet
    Dim valS As String
    Dim opArr() As String
    Dim coll1 As Collection
    Dim coll2 As Collection
    Dim coll3 As Collection
    Dim coll4 As Collection
    Dim coll5 As Collection
    Dim x, y, z As Integer
    Dim lRow1, lRow2 As Long
    
    
    Set thisWB = ThisWorkbook
    Set autoWS = thisWB.Sheets("AUTOMATION")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For x = 2 To 50
    
    If Not autoWS.Cells(x, 1).Value = "o" Then GoTo skip
    If Not autoWS.Cells(x, 2).Value = "y" Then GoTo skip
    
    Set coll1 = New Collection
    Set coll2 = New Collection
    Set coll3 = New Collection
    Set coll4 = New Collection
    Set coll5 = New Collection
    
    For y = 4 To 71 Step 5
    'set colls
    If Not autoWS.Cells(x, y).Value = "" Then
    coll1.Add autoWS.Cells(x, y).Value
    coll2.Add autoWS.Cells(x, y + 1).Value
    coll3.Add autoWS.Cells(x, y + 2).Value
    coll4.Add autoWS.Cells(x, y + 3).Value
    coll5.Add autoWS.Cells(x, y + 4).Value
    If y = 4 Then
    ReDim opArr(0)
    opArr(0) = autoWS.Cells(x, y).Value
    Else
    ReDim Preserve opArr((y + 1) / 5 - 1)
    opArr((y + 1) / 5 - 1) = autoWS.Cells(x, y).Value
    End If
    End If
    Next y
    
    Sheets(opArr).Copy
    Set opWB = ActiveWorkbook
    
    Dim FName As String
    FName = InjectDate(autoWS.Cells(x, 3).Value) 'set filename
    
    If Not InStr(1, FName, ".xlsm") = 0 Or Not InStr(1, FName, ".xlsb") = 0 Then 'if filename contains .xlsm or .xlsb then import vb & assign buttons
    ImportVB.AddBas
    ImportVB.AssignButtons
    End If
    
    
    For z = 1 To coll1.Count
    opWB.Sheets(coll1(z)).Activate
    If coll2(z) = "y" Then
    
    opWB.Sheets(coll1(z)).Range("A1:" & LastColumn(coll1(z), "1") & LastRow(coll1(z), "A")) = opWB.Sheets(coll1(z)).Range("A1:" & LastColumn(coll1(z), "1") & LastRow(coll1(z), "A")).Value
    
    
    End If
    If coll3(z) = "y" Then
    Selection.AutoFilter
    ActiveSheet.Range("A1:" & LastColumn(ActiveSheet.Name, "1") & LastRow(ActiveSheet.Name, "A")).AutoFilter Field:=coll4(z), Criteria1:=coll5(z), Operator:=xlAnd
    End If
    ActiveSheet.Cells(1, 1).Select
    If coll3(z) = "h" Then
    opWB.Sheets(coll1(z)).Visible = False
    End If
    Next z
    
    'save & close output file
    If Not InStr(1, FName, ".xlsm") = 0 Then 'if the filename contains ".xlsm" (NOT =0 means found)
    opWB.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'save as .xlsm
    Else
    If Not InStr(1, FName, ".xlsb") = 0 Then 'if the filename contains ".xlsb" (NOT =0 means found)
    opWB.SaveAs Filename:=FName, FileFormat:=xlExcel12 'save as .xlsb
    Else
    opWB.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbook 'save as .xlsx
    End If
    End If
    
    Application.DisplayAlerts = False
    opWB.Close
    Application.DisplayAlerts = True
    
    skip:
    
    Next x
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    End Sub
    Last edited by Paul_Hossler; 02-26-2020 at 07:28 AM. Reason: Added CODE tags

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Too much code is missing.
    Why not posting the file ?

  3. #3

    File attached

      file attachedGenerator - CAT Huddle Board_V4.xlsm, could you please have a look over it? Thanks heaps

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I tried running it (the "Run" button) and there's missing files that it seems like it wants to import, missing links, etc.

    You'll probably have to either

    1) strip out everything that has nothing to do with the sub Output, or

    2) develop a special driver sub that sets up whatever Output needs and then calls it, or

    3) Use the Immediate Window to try and see what's going on

    Capture.JPG
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    The highlighted line is the next line to run after the error.

    Therefore:
    On Error GoTo ShowMsg '<-- Insert
    For z = 1 To coll1.Count 
       opWB.Sheets(coll1(z)).Activate
       If coll2(z) = "y" Then
          opWB.Sheets(coll1(z)).Range("A1:" & LastColumn(coll1(z), "1") & LastRow(coll1(z), "A")) = opWB.Sheets(coll1(z)).Range("A1:" & LastColumn(coll1(z), "1") & LastRow(coll1(z), "A")).Value
       End If
    ShowMsg: '<-- Add
          If Err <> 0 then 
             MsgBox "Error Number:=" & Err
             MsgBox "coll1.Count:=" & coll1.Count
             MsgBox "y:=" & y
             MsgBox "z:=" & z
             MsgBox "coll2(z):= & coll2(z)
             Exit sub
          End If '<-- End Add
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  6. #6
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    Dim x, y, z As Integer
    If coll2(z) = "y" Then
    Trial...
    Dim x As Integer, y As Integer, z As Integer
    HTH. Dave

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    OTOH, if there's an Overflow, a quick way to test (ax vs. scalpel) is to change ALL Integer to Long as well as explicitly Dim-ing each variable

    As written, x and y are Variants since there is no explicit type
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •