Code running in debug mode - appears to fail dealing with large data entries

Question

I have code that pulls information from certain columns on a worksheet with a dynamic title (depending on month of year e.g. Docs_tracker August, September etc) onto a new spreadsheet named Charger file....

Sub TrackerInfo()
'Pull info from respective column into correct column on charge loader file

Dim wb_mth As Workbook, wb_charges As Workbook, mapFromColumn As Variant, mapToColumn As Variant
    Dim lastCell As Integer, i As Integer, nextCell As Integer

Dim tbl As ListObject
Dim wbNames As Variant, wb As Workbook, w As Workbook, El As Variant, boolFound As Boolean

'2. Dynamic workbook
wbNames = Split("January,February,March,April,May,June,July,August,September,October,November,December", ",")
  For Each w In Workbooks
    For Each El In wbNames
        If w.Name = "Docs_Tracker_" & El & " 2020.xlsm" Then
            Set wb = w: boolFound = True: Exit For
        End If
    Next
    If boolFound Then Exit For 'in order to stop iteration if a lot of workbooks are open
     Next

'3. pulls information

    Set wb_mth = w
    Set wb_charges = Workbooks("Charger_file.xls")

    mapFromColumn = Array("O", "AH", "I", "J", "K", "V", "AF", "AI")
    mapToColumn = Array("A", "B", "C", "D", "E", "J", "K", "L")

        For i = 0 To UBound(mapFromColumn)

            With wb_mth.Worksheets(1)

                lastCell = w.Sheets("owssvr").ListObjects("Table_owssvr").Range.Rows.Count
                .Range(mapFromColumn(i) & 2 & ":" & mapFromColumn(i) & lastCell).Copy

            End With

            With wb_charges.Worksheets(1)

                nextCell = .Range(mapToColumn(i) & .Rows.Count).End(xlUp).Row + 1
                .Range(mapToColumn(i) & nextCell).PasteSpecial Paste:=xlPasteValues

            End With
        Next i
End Sub

Code works perfectly when dealing with small number of entries + when in debug mode, however struggles with larger entries. Going off previous posts, I may need to slow down the code. Could anyone give me any ideas why the code does not appear to be working? DO I need to "slow it down" anywhere (not quite sure what that means!).thank you.

Instead of using the clipboard, you could use [value transfer](https://stackoverflow.com/questions/51528000/vba-paste-as-values-how-to). — BigBen, Dec 08 '20 at 17:42
how would i do that when i am transferring over column? @BigBen — CleanRider, Dec 08 '20 at 17:58

FaneDuru · Answer 1 · 2020-12-08T18:54:17.123

Please, try the next updated code. Not tested, not having your data, but it should work fast. It uses an array to avoid using of clipboard. A single issue looks problematic for me, respectively, the way in which lastCell is calculated, referring another sheet than the one where the range must be copied for:

Sub TrackerInfo()
 Dim wb_mth As Workbook, wb_charges As Workbook, mapFromColumn, mapToColumn
 Dim lastCell As Long, i As Long, nextCell As Long, arrCopy
 Dim wbNames, w As Workbook, El, boolFound As Boolean

'2. Dynamic workbook
 wbNames = Split("January,February,March,April,May,June,July,August,September,October,November,December", ",")
 For Each w In Workbooks
     For Each El In wbNames
        If w.Name = "Docs_Tracker_" & El & " 2020.xlsm" Then
            Set wb_mth = w: boolFound = True: Exit For
        End If
     Next
     If boolFound Then Exit For 'in order to stop iteration if a lot of workbooks are open
 Next

'3. pulls information
    Set wb_charges = Workbooks("Charger_file.xls")

    mapFromColumn = Array("O", "AH", "I", "J", "K", "V", "AF", "AI")
    mapToColumn = Array("A", "B", "C", "D", "E", "J", "K", "L")

        For i = 0 To UBound(mapFromColumn)
            With wb_mth.Worksheets(1)
                lastCell = wb_mth.Sheets("owssvr").ListObjects("Table_owssvr").Range.rows.count '??? please, check here the logic of lastCell finding
                arrCopy = .Range(mapFromColumn(i) & 2 & ":" & mapFromColumn(i) & lastCell)
            End With

            With wb_charges.Worksheets(1)
                nextCell = .Range(mapToColumn(i) & .rows.count).End(xlUp).row + 1
                .Range(mapToColumn(i) & nextCell).Resize(UBound(arrCopy), UBound(arrCopy, 2)).Value = arrCopy
            End With
        Next i
End Sub

although this is useful - the problem has not gone away - i can only run the code in debug mode — CleanRider, Dec 08 '20 at 22:34

Code running in debug mode - appears to fail dealing with large data entries

1 Answers1