VBA - Code keeps crashing

[RCBricker]

Hello all,

I am having some difficulty determining why this code crashes at times.

Sub GL_to_TB_RECON_TEM()

Dim wb As Workbook, wbGL As Workbook, wbTB As Workbook, wbRECON As Workbook
Dim wsGL As Worksheet, wsTB As Worksheet, ws As Worksheet, wsRGL As Worksheet, _
    wsRDTB As Worksheet, wsR As Worksheet, wsRGTB As Worksheet, wsRTB As Worksheet
Dim vFILEn As Variant
Dim lngROW As Long, lngCOL As Long
Dim intMA As Integer, intCOL As Integer
Dim rngHEAD As Range, rng As Range
Dim loTBL As ListObject, loTBLgtb As ListObject, loTBLdtb As ListObject, loTBLgl As ListObject
Dim strMON As String, strFY As String, strSYS As String, strQRT As String, strPATH
Dim strNAME As String, strFILE As String

On Error GoTo ErrCapture

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    '.ScreenUpdating = True
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

40000       Set wb = ThisWorkbook
40001       Workbooks.Add Template:="J:\Shared\J4-8C\CBDP Team\CBDP recon Templates\GL to TB Recon Template.xltx"
40002       Set wbRECON = ActiveWorkbook
40003       strPATH = "\\user.dtra.dec\hdi\home\bricker\Desktop\Recon destination - dont delete\"
40004       strNAME = "GL to TB Recon Template.xlsx"
40005       strFILE = strPATH & strNAME
40006       wbRECON.SaveAs FileName:=strFILE
40007       Set wsR = wbRECON.Sheets("Recon GL to TB")
40008       Set wsRDTB = wbRECON.Sheets("DAI TB")
40010       Set wsRGTB = wbRECON.Sheets("GFEBS TB")
40011       Set wsRGL = wbRECON.Sheets("GL")
'40012       Set loTBLdtb = wsRDTB.ListObjects(1)
'40013       Set loTBLgtb = wsRGTB.ListObjects(1)
'40014       Set loTBLgl = wsRGL.ListObjects(1)
40015       vFILEn = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xls*", Title:="Select DRCED GL Data file to open")
40016       If vFILEn = False Then
40017           MsgBox "User Failed to select a DRCED GL file to process.  Please start over"
40018           With Application
40019               .DisplayAlerts = True
40020               .ScreenUpdating = True
40021               .Calculation = xlCalculationAutomatic
40022               .EnableEvents = True
40023           End With
40024           End
40025       End If
40026       Set wbGL = Workbooks.Open(FileName:=vFILEn)
DoEvents
'40027                   Set wbGL = Workbooks.Open(FileName:="\\user.dtra.dec\hdi\home\bricker\Desktop\FY 2019 Recons\01 All Data\DRCED Data\DATA\19-02-04-GFEBS-GL-DRCED.XLSX")
40029       Set wsGL = wbGL.Sheets(1)
40030       strMON = Mid(wbGL.Name, 7, 2)
40031       strFY = Left(wbGL.Name, 2)
40032       wsRGL.Name = strFY & "-" & strMON & "-GL Data"
40033       With wsGL
40034           Set loTBL = wsGL.ListObjects(1)
40035           Range("" & loTBL.Name & "[[CBDP UID]:[CBDP Main Acct]]").Copy
40036           wsRGL.Cells(7, 1).PasteSpecial xlPasteValues
40037           wbGL.Close False
DoEvents
40038           With wsRGL
40039               lngROW = LASTrow(wsRGL)
40040               lngCOL = LASTCOL(wsRGL)
40041               Set rng = wsRGL.Range(wsRGL.Cells(6, 1), wsRGL.Cells(lngROW, lngCOL))
40042               Set loTBLgl = wsRGL.ListObjects.Add(xlSrcRange, rng, , xlYes)
40043               wsRGL.ListObjects(loTBL).Name = "tblGL"
40044           End With
40045       End With
40046       vFILEn = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xls*", Title:="Select System TB Data file to open")
40047       If vFILEn = False Then
40048           MsgBox "User Failed to select a System TB Data file to process.  Please start over"
40049           With Application
40050               .DisplayAlerts = True
40051               .ScreenUpdating = True
40052               .Calculation = xlCalculationAutomatic
40053               .EnableEvents = True
40054           End With
40055           End
40056       End If
40057       Workbooks.Open FileName:=vFILEn
DoEvents
40058       Set wbTB = ActiveWorkbook
'40059                   Set wbTB = Workbooks.Open(FileName:="\\user.dtra.dec\hdi\home\bricker\Desktop\FY 2019 Recons\01 All Data\TB\GFEBS\19-02-04-GFEBS-TB Combined-SYS.xlsx")
40060       Set wsTB = wbTB.Sheets(1)
40061       strMON = Mid(wbTB.Name, 7, 2)
40062       strFY = Left(wbTB.Name, 2)
40063       With wsTB
40064           If wsTB.ListObjects.Count < 1 Then
40065               lngROW = LASTrow(wsTB)
40066               lngCOL = LASTCOL(wsTB)
40067               Set rng = wsTB.Range(wsTB.Cells(1, 1), wsTB.Cells(lngROW, lngCOL))
40068               wsTB.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "tblTB"
40069           End If
40070           Set loTBL = wsTB.ListObjects(1)
40071           If wsTB.Range("A1").Value = "Period" Then
40072               strSYS = "DAI"
40073               If Not wsTB.Range("A1").Value = "CBDP UID" Then
40074                   Call DAI_ADD_COLS(wbTB, wsTB, loTBL)
40075               End If
40076               Set wsRTB = wsRDTB
40077               wsRTB.Name = strFY & "-" & strMON & "-TB Data"
40078               wsRGTB.Delete
40079               Range("" & loTBL.Name & "[[CBDP UID]:[CBDP Main Acct]]").Copy
40080               With wsRTB
40081                   lngROW = LASTrow(wsRTB)
40082                   lngCOL = LASTCOL(wsRTB)
40083                   wsRTB.Cells(7, 1).PasteSpecial xlPasteValues
40084                   Set rng = wsRTB.Range(wsRTB.Cells(6, 1), wsRTB.Cells(lngROW, lngCOL))
40085                   wsRTB.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "tblTB"
40086                   Set loTBLgl = wsRTB.ListObjects(1)
40087               End With
'*****************************************************************************************
'more code after this, but this is where the crashing is occurring.  If I F8 through the code it doesn't crash.
end with
end sub

any thoughts?

 

[jondavis1987]

My guess is because you have two end withs in a row from the looks of it. What happens if you take out one of the end with statements

 

[offthelip]

Another possiblity is it using the clipboard for copying which is causing the spurious crashes
Try doing the copying using variant arrays instead of the clipboard, for example:
change:

Range("" & loTBL.Name & "[[CBDP UID]:[CBDP Main Acct]]").Copy
wsRGL.Cells(7, 1).PasteSpecial xlPasteValues

to

inarr = Range("" & loTBL.Name & "[[CBDP UID]:[CBDP Main Acct]]")
rr = UBound(inarr, 1)
cc = UBound(inarr, 2)
wsRGL.Range(Cells(7, 1), Cells(7 + rr, 1 + cc)) = inarr