I have the following VBA code. Essentially, I pull in data from other spreadsheets in my network drive and make some manipulations to the data that I pulled in. The code is executing entirely, and I’m getting the output that I need. However, at the end of each time I run the macro I keep getting an “overflow error” with the only options to “End”, “Debug”, or “Help”. I just want to stop this dialog box error from coming up. What can I do?
Sub ProcessCollateralReports()
Dim networkFolder As String: networkFolder = “pathnamefoldername”
Dim folder As String
Dim subfolder As String
Dim filePath As String
Dim wb As Workbook
Dim destWb As Workbook ‘Destination workbook – this is the workbook where we are pasting our values from the source worksheet
Dim destSheet As Worksheet ‘Destination worksheet – this is the sheet within the workbook where we are pasting our values. This is the final worksheet that we need at the end
Dim lastRow As Long
Dim cell As Range
Dim sourceWs As Worksheet ‘Source worksheet – this is where we are extracting the values from
Dim destRow As Long
Dim folderDate As String
Dim dateFormat As String: dateFormat = “yyyymmdd”
Dim dataRange As Range
Dim file As String
Dim dateValue As Variant ‘ Declare as Variant for For Each loop
Dim r As Long
Dim i As Long
Dim j As Long
' Open the destination workbook
On Error Resume Next
Set destWb = Workbooks("endfile.xlsm")
If destWb Is Nothing Then
MsgBox "Destination workbook 'endfile.xlsm' is not open.", vbCritical
Exit Sub
End If
On Error GoTo 0
' Set the destination sheet
On Error Resume Next
Set destSheet = destWb.Sheets("Sheet1")
If destSheet Is Nothing Then
MsgBox "Sheet 'Sheet1' does not exist in the destination workbook.", vbCritical
Exit Sub
End If
On Error GoTo 0
destRow = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row + 1
'''Identify all folders
Dim fldrStack As Object: Set fldrStack = CreateObject("System.Collections.Stack")
folder = Dir(networkFolder, vbDirectory)
While folder <> ""
If IsDateFormat(folder, dateFormat) Then fldrStack.Push folder
folder = Dir()
Wend
'''
'''Loop through the identified folders
While fldrStack.Count > 0
folder = fldrStack.Pop()
folderDate = Format(CDate(Left(folder, 4) & "-" & Mid(folder, 5, 2) & "-" & Right(folder, 2)), "mm/dd/yyyy")
subfolder = networkFolder & folder & "InternalInternal_Reports"
file = Dir(subfolder & "Position_Summary_Report_" & folder & ".xls")
If file <> "" Then
filePath = subfolder & file
Set wb = Workbooks.Open(filePath)
Set sourceWs = wb.Sheets(1)
' Define the data range
lastRow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
Set dataRange = sourceWs.Range("A6:AT" & lastRow)
' Apply filters
dataRange.AutoFilter Field:=1, Criteria1:="Bob"
dataRange.AutoFilter Field:=44, Criteria1:="=*Alice*", Operator:=xlAnd
' Copy filtered data to destination sheet
On Error Resume Next
Set dataRange = sourceWs.Range("A7:AT" & lastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not dataRange Is Nothing Then
dataRange.Copy destSheet.Cells(destRow, 2) ' Paste starting from column B to leave column A for dates
' Add the folder date beside each copied row
For Each cell In destSheet.Range(destSheet.Cells(destRow, 2), destSheet.Cells(destSheet.Rows.Count, 2).End(xlUp))
If cell.Value <> "" Then
cell.Offset(0, -1).Value = folderDate
End If
Next cell
destRow = destSheet.Cells(destSheet.Rows.Count, "B").End(xlUp).Row + 1
End If
wb.Close SaveChanges:=False
End If
Wend
'''Tidy Up
fldrStack.Clear
Set fldrStack = Nothing
'''Adding new columns to insert the transformed and pasted data
For j = 1 To 89
destSheet.Columns(1).Insert Shift:=x1ToRight
Next j
'''Deleting the first row since it is blank in the output
destSheet.Rows(1).EntireRow.Delete
'''Various transformations
For i = 1 To lastRow
destSheet.Cells(i, "B").Value = "Manual"
destSheet.Cells(i, "C").Value = "BBNA"
destSheet.Cells(i, "D").Value = "BBNA"
destSheet.Cells(i, "H").Value = 0
destSheet.Cells(i, "I").Value = "IS"
destSheet.Cells(i, "L").Value = "Bob"
destSheet.Cells(i, "M").Value = "NOTE"
destSheet.Cells(i, "N").Value = "Alice"
destSheet.Cells(i, "R").Value = "Bob"
destSheet.Cells(i, "W").Value = 1.01
destSheet.Cells(i, "U").Value = "Jane"
destSheet.Cells(i, "AM").Value = "B"
destSheet.Cells(i, "AN").Value = "Rob"
destSheet.Cells(i, "AP").Value = 0
destSheet.Cells(i, "AR").Value = "2049"
destSheet.Cells(i, "AT").Value = "T"
destSheet.Cells(i, "AU").Value = 360
destSheet.Cells(i, "AX").Value = 0
destSheet.Cells(i, "AY").Value = 0
destSheet.Cells(i, "BB").Value = 0
destSheet.Cells(i, "BC").Value = 0
destSheet.Cells(i, "BE").Value = "Smith"
destSheet.Cells(i, "BF").Value = "Steve"
destSheet.Cells(i, "BG").Value = "BBNA"
destSheet.Cells(i, "CD").Value = "MATT"
destSheet.Cells(i, "A").Value = destSheet.Cells(i, "CL").Value
destSheet.Cells(i, "J").Value = destSheet.Cells(i, "DK").Value
destSheet.Cells(i, "K").Value = destSheet.Cells(i, "DJ").Value
'''More transformations and formatting
Select Case destSheet.Cells(i, "CN").Value
Case "abc"
destSheet.Cells(i, "E").Value = "BBNA - abc"
destSheet.Cells(i, "F").Value = "1234"
destSheet.Cells(i, "G").Value = "Jane Doe"
Case "def"
destSheet.Cells(i, "E").Value = "BBNA - def"
destSheet.Cells(i, "F").Value = "5678"
destSheet.Cells(i, "G").Value = "Rob Smith"
End Select
If IsDate(destSheet.Cells(i, "A").Value) Then
destSheet.Cells(i, "AQ").Value = Format(destSheet.Cells(i, "A").Value, "dd/mm/yyyy")
End If
If IsDate(destSheet.Cells(i, "DI").Value) Then
destSheet.Cells(i, "BN").Value = Format(destSheet.Cells(i, "DI").Value, "dd/mm/yyyy")
End If
destSheet.Cells(i, "BZ").Value = destSheet.Cells(i, "AQ").Value
destSheet.Cells(i, "BA").Value = destSheet.Cells(i, "AO").Value * destSheet.Cells(i, "BK").Value
destSheet.Cells(i, "BD").Value = destSheet.Cells(i, "AZ").Value * destSheet.Cells(i, "BK").Value
Next i
End Sub
”’Getting the date in the right format
Function IsDateFormat(folderName As String, dateFormat As String) As Boolean
IsDateFormat = (Len(folderName) = Len(dateFormat)) And IsNumeric(Left(folderName, 4)) And IsNumeric(Mid(folderName, 5, 2)) And IsNumeric(Right(folderName, 2))
End Function