Announcement

Collapse
No announcement yet.

<3Speed up code? This simple VBA code makes a report but its taking 15 minutes.

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • <3Speed up code? This simple VBA code makes a report but its taking 15 minutes.



    This macro is for a bus workshop, it reviews the excel DB and makes me a report of all the expenses per bus which ends up giving 2k rows.

    Can you please tell me how to speed up this macro? 15 minutes is a lot of time.

    ||| macro below:

    Code:
    Sub getallExpensesperbus()
    
    Application.ScreenUpdating = False
    
    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim selectsheet As Worksheet
    
    Dim idcamion As String
    Dim finalrow As Integer
    Dim i As Integer
    
    Set datasheet = Page1
    Set reportsheet = Page2
    Set selectsheet = Page3
    
    reportsheet.Select
    reportsheet.Range("A4:K300000").ClearContents
    Sheets("BDProducts").Visible = True
    datasheet.Select
    finalrow = Page1.Range("Q2").Value
    
    For i = 2 To finalrow
    If Cells(i, 8).Value <> "" Then
    price = Cells(i, 3).Value
    ID = Cells(i, 2).Value
    product = Cells(i, 1).Value
    unit = Cells(i, 4).Value
    quantity = Cells(i, 5).Value
    address = Cells(i, 9).Value
    time = Cells(i, 10).Value
    comments = Cells(i, 7).Value
    side = Cells(i, 13).Value
    mileage = Cells(i, 14).Value
    bus= Cells(i, 8).Value
    
    reportsheet.Select
    finalrow2 = WorksheetFunction.CountA(Range("A:A")) + 2
    
    Cells(finalrow2, 1).Value = bus
    Cells(finalrow2, 2).Value = product
    Cells(finalrow2, 3).Value = ID
    Cells(finalrow2, 4).Value = unit
    Cells(finalrow2, 5).Value = quantity
    Cells(finalrow2, 6).Value = price
    
    Cells(finalrow2, 7).Value = adress
    Cells(finalrow2, 8).Value = time
    Cells(finalrow2, 9).Value = comments
    Cells(finalrow2, 10).Value = side
    Cells(finalrow2, 11).Value = mileage
    
    datasheet.Select
    End If
    Next i
    
    reportsheet.Select
    Range("A4").Select
    
    Application.ScreenUpdating = True
    
    End Sub
    Last edited by AlanSidman; 1 week ago.

  • #2
    Code Tags Added
    Your post does not comply with our Forum RULES. Use code tags around code.

    Posting code between tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

    Highlight your code and click the # icon at the top of your post window.

    (I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)
    Alan

    Did you debug your code first? http://www.cpearson.com/excel/DebuggingVBA.aspx
    FORUM RULES----->http://www.ozgrid.com/forum/announcement.php?f=8

    If someone has helped you, say "thank you" by clicking on the Like Button.

    Comment


    • #3
      If you have a lot of formulas in your worksheets, I would urge you to add code to turn off automatic calculations and turn them back on at the very end of your code.
      Alan

      Did you debug your code first? http://www.cpearson.com/excel/DebuggingVBA.aspx
      FORUM RULES----->http://www.ozgrid.com/forum/announcement.php?f=8

      If someone has helped you, say "thank you" by clicking on the Like Button.

      Comment


      • #4
        Try this.
        Code:
        Sub GetBusExpenses()
            Dim x, y(), z, i As Long, ii As Long, lCnt As Long
            
            x = Page1.Cells(1).CurrentRegion
            For i = 2 To Page1.[q2]
                If x(i, 8) <> "" Then
                    lCnt = lCnt + 1: ReDim Preserve y(1 To 11, 1 To lCnt)
                    y(1, lCnt) = x(i, 8): y(2, lCnt) = x(i, 1): y(3, lCnt) = x(i, 2): y(4, lCnt) = x(i, 4)
                    y(5, lCnt) = x(i, 5): y(6, lCnt) = x(i, 3): y(7, lCnt) = x(i, 9): y(8, lCnt) = x(i, 10)
                    y(9, lCnt) = x(i, 7): y(10, lCnt) = x(i, 13): y(11, lCnt) = x(i, 14)
                End If
            Next
            ReDim z(1 To lCnt, 1 To 11)
            For i = 1 To lCnt
                For ii = 1 To 11
                    z(i, ii) = y(ii, i)
                Next
            Next
            With Page2
                .[a4].Resize(300000, 11).ClearContents
                .[a4].Resize(lCnt, 11) = z
            End With
            
        End Sub
        We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

        Comment


        • #5
          Originally posted by KjBox View Post
          Try this.
          Code:
          Sub GetBusExpenses()
          Dim x, y(), z, i As Long, ii As Long, lCnt As Long
          
          x = Page1.Cells(1).CurrentRegion
          For i = 2 To Page1.[q2]
          If x(i, 8) <> "" Then
          lCnt = lCnt + 1: ReDim Preserve y(1 To 11, 1 To lCnt)
          y(1, lCnt) = x(i, 8): y(2, lCnt) = x(i, 1): y(3, lCnt) = x(i, 2): y(4, lCnt) = x(i, 4)
          y(5, lCnt) = x(i, 5): y(6, lCnt) = x(i, 3): y(7, lCnt) = x(i, 9): y(8, lCnt) = x(i, 10)
          y(9, lCnt) = x(i, 7): y(10, lCnt) = x(i, 13): y(11, lCnt) = x(i, 14)
          End If
          Next
          ReDim z(1 To lCnt, 1 To 11)
          For i = 1 To lCnt
          For ii = 1 To 11
          z(i, ii) = y(ii, i)
          Next
          Next
          With Page2
          .[a4].Resize(300000, 11).ClearContents
          .[a4].Resize(lCnt, 11) = z
          End With
          
          End Sub
          I know my request is ambitious but i'm perplexed by your code. I thoroughly believe that a human who helps another with beautiful information like this deserves a better future.

          What's the logic behind these three blocks: .
          1) [a4].Resize(lCnt, 11) = z
          2) lCnt = lCnt + 1: ReDim Preserve y(1 To 11, 1 To lCnt)
          3) ReDim z(1 To lCnt, 1 To 11)
          For i = 1 To lCnt
          For ii = 1 To 11
          z(i, ii) = y(ii, i)



          ps it worked! im amazed, perplexed, everyone who helped is k'eng and IDK MY WEEKEND HAS BEEN MADE, I DIDNT KNOW I WOULD FIND SOMETHING AS BEAUTIFUL AS WHAT I LEARNED WITH YOU

          Comment


          • #6
            In a nutshell, there are 2 ways of writing VBA code, object based and array based.

            In the case of object based, as your original code was, for every iteration of the loop data has to be read from the worksheet for the data row concerned, that data then gets written back to the Report sheet in the required order.

            In the case of array based, my code, all the data is read in one go and kept in the computer memory in the form of an array (variable x), then the code loops through that array and for every time item x(i, 8) is not empty the required data is placed into a second array (variable y), the size of array y gets increased by 1 for each time x(i, 8) is not empty.

            Since it is not possible to increase the first dimension of an array, only the second dimension, array y ends up with the data transposed from what is actually required. It is possible to place the data back to a worksheet with the data in the required format by using "Application.Transpose". However, this method has a tendency to fail with large arrays, so the data is first transposed into a third array (variable z).

            All of the above is done within the computer memory using C++ language which is very much faster than VBA, the data is read from the data worksheet just once and placed back to the report sheet just once, as opposed to the thousands of times data gets read and posted back when an object based code is used. This makes the code run much faster (the more data involved the greater the difference between object based and array based run times).

            To answer your specific points:

            1). This is where the contents of array z are placed onto the Report sheet, Range A4 is first resized to the correct number of rows and columns to match the size of array z.

            2). This is where array y gets its second dimension increased by 1 for every iteration of the loop when item x(i, 8) is not empty. The "Preserve" ensures that the contents of the array before re-dimming are not lost.

            3). This is where array z is loaded with all the data contained in array y but with the dimensions reversed (data is transposed).

            I hope that makes it clearer.

            Out of interest how much faster did the code run using my code?
            We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

            Comment


            • #7
              https://www.excelforum.com/excel-pro...to-finish.html

              Comment


              • #8


                Originally posted by KjBox View Post
                A
                My code took 15 minutes and your code takes less than 5 seconds, see why I'm perplexed? I couldn't even reply before, I'm just zoning in my mind how good that is, because now I can fix the input/output of iterations and transactions... but I need to understand your code better to be able to do that, it would be similar but I'm not a seasoned coder

                Comment

                Working...
                X