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!!!
Code:
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
