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



Reply With Quote
