2

I have written a macro in Excel VBA that basically copy-pastes 53 rows 1440 times, one under another, in order to populate two columns in a ~70000 row table. The macro works, but it takes about five minutes to run completely. This would be fine if I didn't have to run this on ~1000 other files. I am looking for any way to speed up this process so that it doesn't take 5 days to run.

I tried using the range copy method:

    Set range1 = {the table I'm copying} 
    Set range2 = {the cells I want to paste into} 
    range1.Copy range2

but it took just as long, if not longer.

Here is my current code:

    Windows("as_built_comp.xlsm").Activate
    Sheets(siteName).Activate
    j = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Activate
    Range("I12").Select
    For i = 1 To 1440
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
              SkipBlanks _
        :=False, Transpose:=False
        ActiveWindow.SmallScroll Down:=56
        ActiveCell.Offset(j - 1, 0).Select
    Next i

I'm thinking the solution might have something to do with using sql in VBA, but I have yet to learn that syntax. Either way, any advice is greatly appreciated. Thank you for reading!

pizookie
  • 47
  • 3
  • 4
    Remove all the '.Activate` and `.Select`. This is unnecessary steps that slows down your code. Qualify your objects with sheets - this will remove the need for your code to care what is selected or active. You can also try a value transfer instead of a copy/paste. This is much faster – urdearboy Jun 11 '19 at 17:24
  • 2
    See [this](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – cybernetic.nomad Jun 11 '19 at 17:24

1 Answers1

2

Load it all into an array and then output the entire array at the end. Code refactored to avoid the use of activate/select

Sub tgr()

    Dim wbDest As Workbook
    Dim wbData As Workbook
    Dim wsDest As Worksheet
    Dim wsData As Worksheet
    Dim aTemp() As Variant
    Dim aData() As Variant
    Dim SiteName As String
    Dim RepeatData As Long
    Dim ixTemp As Long
    Dim ixData As Long
    Dim ixCol As Long

    SiteName = "SiteName1"
    RepeatData = 1440

    Set wbDest = ThisWorkbook
    Set wbData = Workbooks("as_built_comp.xlsm")
    Set wsDest = wbDest.Worksheets(1)
    Set wsData = wbData.Worksheets(SiteName)

    With wsData.Range("C2:D" & wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row)
        If .Row < 2 Then Exit Sub   'No data
        aTemp = .Value
        ReDim aData(1 To .Rows.Count * RepeatData, 1 To .Columns.Count)
    End With

    For ixData = 1 To UBound(aData, 1)
        ixTemp = ((ixData - 1) Mod UBound(aTemp, 1)) + 1
        For ixCol = 1 To UBound(aTemp, 2)
            aData(ixData, ixCol) = aTemp(ixTemp, ixCol)
        Next ixCol
    Next ixData

    wsDest.Range("I12").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData

End Sub
tigeravatar
  • 26,199
  • 5
  • 30
  • 38
  • This was perfect!!! Thank you so much for your help- this literally ran in an instant. You're a lifesaver!! – pizookie Jun 11 '19 at 21:25