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



    [VBA]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
    [/VBA]



    Can anybody give me a hand with this??

  • 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.

    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.

  • 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) [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"error 9.jpg","data-attachmentid":1221745}[/ATTACH] 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,

  • 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.

  • "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.

  • .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.

  • KjBox,

    Quote

    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.

  • [B]KjBox,[/B]


    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,

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


    For example:

    [VBA]ElseIf q.Value <> "" And q.Offset(-1, 0).Value <> 5 Then q.Value = ""[[/VBA] 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.

  • Try this

    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.