Consulting

Results 1 to 4 of 4

Thread: Optimize a VBA loop

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    Optimize a VBA loop

    I've got a vba sub which I think can be optimized to work much faster. I have a list of names in Column A on a worksheet "Data":

    Abe-2061-07
    Abe-2159-08
    Abe-2281-09
    Abe-2430-10
    ETC

    On another worksheet "Inventions" I have a template which I want to copy for each name in the list. My vba code looks like:

    Sub InventionCashFlows()
    'Creates cash flow for each unique invention
    Dim invention As Integer
    Dim numberofinventions As Integer
    Dim rowoffset As Integer
    Dim namerowoffset As Integer
    With Sheets("Inventions")
        .Rows(18 & ":" & .Rows.Count).Clear
    End With
    Sheets("Data").Select
    invention = 1
    numberofinventions = Application.WorksheetFunction.CountA(Range("a2", Range("a2").End(xlDown))) - 1
    For invention = 1 To numberofinventions
    rowoffset = invention * 17
    namerowoffset = invention * 17 - 17
    Sheets("Data").Select
        Range("a1").Offset(invention, 0).Select
        Selection.Copy
    Sheets("Inventions").Select
        Range("A2").Offset(namerowoffset, 0).Select
        ActiveSheet.Paste
    ActiveWorkbook.Worksheets("Inventions").Rows("2:17").Select
        Selection.Copy
        Range("A2").Offset(rowoffset, 0).Select
        ActiveSheet.Paste
        
    Next invention
    namerowoffset = invention * 17 - 17
    Sheets("Data").Select
        Range("a1").Offset(invention, 0).Select
        Selection.Copy
    Sheets("Inventions").Select
        Range("A2").Offset(namerowoffset, 0).Select
        ActiveSheet.Paste
        
    Range("A1").Select
    End Sub
    Ideas on how to optimize?

    Sample spreadsheet Attached
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •