Announcement

Collapse
No announcement yet.

Optimize this vba code

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

  • Optimize this vba code



    Hi guys,

    It's my first time posting, although I've been reading from this forum for a while now.

    Lets see if anyone can help me with this code.

    The code works fine, it does what it's supposed to, but it takes ages to do it. And by ages I mean over 9 mins. And the truth is that I need to run it on 8 sheets. So over 9 mins x 8 sheets = a life time


    As a backgroud of my spreadsheet, let me tell you that it's a 65 Mb file. It has a conection to a folder, where it gathers de data as a data model. It has 15 sheets. In most of the there are pivot tables conected to the data model.

    Here is the code


    Sub Monetry_cambio_spain()

    Dim q As Range

    Worksheets("Monetary Spain").Activate


    For Each q In Range("B53:JJQ53")

    If q.Value = "" And q.Offset(-1, 0).Value = 5 Then

    q.Value = Now

    ElseIf q.Value <> "" And q.Offset(-1, 0).Value <> 5 Then

    q.Value = ""

    End If

    Next q





    End Sub



    Can anybody give me a hand with this??

  • #2
    Thanks

    Comment


    • #3
      Try this, you will need to modify the code to include the sheet names for the other 7 sheets on which the code needs to run.
      Code:
      Sub test()
          Dim x, y, e, i As Long, ws As Worksheet
          
      '// Replace , "sheet2", "sheet3" up tp "Sheet8" with actual sheet names
          y = Array("Monetary Spain", "sheet2", "sheet3", "sheet4", _
                      "sheet5", "sheet6", "sheet7", "sheet8")
          
          Application.ScreenUpdating = 0
          For Each e In y
              With Sheets(e).Range("b52:jjq53")
                  x = .Value
                  For i = 1 To UBound(x, 2)
                      If x(2, i) = vbNullString And x(1, i) = 5 Then x(2, i) = Now
                  Next
                  .Value = x
              End With
          Next
          
      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


      • #4
        KjBox,

        Thanks for the quick reply.

        I'm geting a error 9 on this line:
        If x(2, i) = vbNullString And x(1, i) = 5 Then "Subindex out of the interval" (I have it in spanish, so this is my quick translation of the error) Click image for larger version

Name:	error 9.jpg
Views:	9
Size:	33.2 KB
ID:	1221745 I've only placed 1 sheet to test it.

        I can't figure the error. (on my basic understanding of the code, I don't fully understan the concept of ".value", plus of whay the missing "End If"

        Cheers,
        Attached Files

        Comment


        • #5
          You also changed the range from "b52:jjq53" to "b53:jjq53"

          The "b52" was not a typo it needs to be as I had it.
          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


          • #6
            "End If" is not needed when the result of an If statement is on the same line as the "If"
            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
              .Value is used to place the values of Range B52:JJQ53 into array x

              The code then loops through the 2nd dimension of array x and changes the value to "Now" if the first dimension is 5

              The values in the modified array x are then placed back on the sheet (replacing existing values on the sheet)
              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


              • #8
                KjBox,
                The "b52" was not a typo it needs to be as I had it.
                Sorry my mistake. I thought my clumsy hand where to blame.

                Placed it back as your original code and ir works like a charme and in just a few seconds!!!

                I really appreciate it. You're a life savior.

                Comment


                • #9
                  You're welcome.
                  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


                  • #10
                    It's a good idea to restore Screen Updating at the end of the code.
                    Hope that Helps

                    Roy

                    New users should read the Forum Rules before posting

                    For free Excel tools & articles visit my web site

                    RoyUK's Web Site

                    royUK's Database Form

                    Where to paste code from the Forum

                    About me.

                    Comment


                    • #11
                      KjBox,

                      just to let you know. Something I did not mentiones in my original post.

                      The values on row (B52:JJQ52) are formulas, that get updated automaticly. When I run the macro you mentioned, it erases the formula and just sets the value on the cell.

                      It's not a big deal, as I can just place a basic macro before this one to palce the formula on the row, so it gets updated first.

                      Regards,

                      Comment


                      • #12
                        After further testing, the suggestion given doesn't cover other aspects of the original code.

                        For example:

                        ElseIf q.Value <> "" And q.Offset(-1, 0).Value <> 5 Then q.Value = ""[
                        This part of the code, wich is important, doesn't get updated. For example if a cell in row 52 changes to 4 instead of 5, the macro doesn't wipe out the content in row 53.

                        Comment


                        • #13


                          Try this
                          Code:
                          Sub test()
                              Dim x, y, z, e, i As Long, ws As Worksheet
                              
                          '// Replace , "sheet2", "sheet3" up tp "Sheet8" with actual sheet names
                              x = Array("Monetary Spain", "sheet2", "sheet3", "sheet4", _
                                          "sheet5", "sheet6", "sheet7", "sheet8")
                              
                              Application.ScreenUpdating = 0
                              For Each e In x
                                  With Sheets(e)
                                      y = .Range("b52:jjq52"): z = .Range("b53:jjq53")
                                      For i = 1 To UBound(y, 2)
                                          If y(1, i) = 5 Then
                                              If z(1, i) = vbNullString Then z(1, i) = Now
                                          Else
                                              z(1, i) = vbNullString
                                          End If
                                      Next
                                      .Range("b53:jjq53") = z
                                  End With
                              Next
                              Application.ScreenUpdating = 1
                          End Sub
                          Last edited by pike; 11 hours ago.
                          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

                          Working...
                          X