Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 22

Thread: Improve Efficiency of VBA Code

  1. #1

    Improve Efficiency of VBA Code

    Hi,
    I'm new here and hope you guys can gimme a little help!
    Row number 6 in this Attached example contains many hypothetical formulas, These formulas will be converted to its values From row number 8 to last row of data.
    Macro is running fine but it takes more time with large amounts of data.
    Is there a more efficient and quicker way to do?
    I would appreciate any help that can be offered by way of the best approach to such a task.
    please see what I have so far. Thanks in advance.
    Attached Files Attached Files
    Last edited by jonsonbero; 05-22-2020 at 03:31 PM.

  2. #2
    Is there a way to improve it ..?
    or what is in the code that makes the code runs slowly?

  3. #3
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
    To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
    So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),
    So you need to redesign your code to avoid searching the worksheet and avoid writing to individual cells. It is not clear from your worksheet what you final objective is but it is very inefficient and slow to use vba to write equations to the worksheet and then change the equations to values. It is much better to load all the data from the worksheet into a variant array do all the calculations in VBA and then write the values back. that would take milliseconds to do what you macro is doing.
    I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,124
    Location
    Cross-posted - and given extensive help before posting here - at: https://www.excelforum.com/excel-pro...-vba-code.html
    Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
    Rules are made to be broken. Many times you can't use an array:

    1. Formatting is required
    2. Imperceptible performance improvements not work the complexity
    3. Debugging is oft times easier on a WS

    In OP's case, since there are formulas in row 6 being used, I don't think trying to use an array would be worth the trouble of using the formulas


    However, if the computations can be incorporated into the macro instead of the WS formulas, then I think it would be worthwhile using arrays if there's lots of data

    Option Explicit
    
    
    
    
    Sub test()
        Dim ws As Worksheet
        Dim rData As Range
        Dim aryData As Variant
        Dim r As Long
        
        Application.ScreenUpdating = False
        
        Set ws = Worksheets("main workbook")
    
        'row 6 formulas cleared
        Set rData = ws.Cells(7, 1).CurrentRegion
        
        aryData = rData.Value
    
    
    
    
        For r = LBound(aryData, 1) + 1 To UBound(aryData, 1)
            If aryData(r, 1) > 0 Then
                aryData(r, 2) = 100
                aryData(r, 7) = 1600
                aryData(r, 8) = 1500
                aryData(r, 11) = 100
                aryData(r, 15) = "Very Good"
                aryData(r, 18) = 500
                aryData(r, 154) = 100
                aryData(r, 156) = "Wonderful"
            End If
        Next r
        
        rData.Value = aryData
        
        Application.ScreenUpdating = True
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,919
    @PH

    Non of your statements is valid.
    It is being illustrated by the redundancies in your code.

    Sub M_snb()
      sn = sheet1.Cells(7, 1).CurrentRegion
      sp = array(2,7,8,11,15,18,154,156)
      sq = array(100,1600,1500,100,"Very good",500,100,"Wonderful")
    
      For j= 2 To UBound(sn)
        If sn(j, 1) > 0 Then
           for jj=0 to 7
             sn(j, sp(jj)) = sq(jj)
           next
        End If
      Next
    
      sheet1.cells(1,7).currentregion = sn
    End Sub

  7. #7
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    Quote Originally Posted by snb View Post
    @PH

    None of your statements are valid.
    It is being illustrated by the redundancies in your code.
    1. You're entitled to your opinion, even if it is wrong

    2. See #1



    The OP said that the data was formula based and provided some trivial examples of formulas in row 6 to fill down the column, and then make into values

    I said ...

    However, if the computations can be incorporated into the macro instead of the WS formulas, then I think it would be worthwhile using arrays if there's lots of data
    Your macro doesn't address the issue and only forces in hard coded numbers which is probably useless as an example

    My not-redundant code example only intends to show how the macro could a) take WS data into an array, b) calculate values within the array, and then c) put the .Values back to the WS
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    Thank you everyone for your support
    I am attaching the new file Please have a look at the example in "main workbook" to see what I mean.
    Sub test()
        Dim ws As Worksheet, rng As Range, cl As Range, lr As Long, c As Long
        Const fRow As Long = 6
        Const sRow As Long = 8
        
        Application.ScreenUpdating = False
            Set ws = ThisWorkbook.Worksheets("main workbook")
            lr = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set rng = ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
            
            For Each cl In rng
                c = cl.Column
                ws.Cells(fRow, c).Copy: ws.Cells(sRow, c).PasteSpecial Paste:=xlPasteFormulas
                
                With ws.Range(ws.Cells(sRow, c), ws.Cells(lr, c))
                    .Formula = ws.Cells(sRow, c).Formula
                   .Value = .Value
                End With
            Next cl
            Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub

    Any help would be greatly appreciated!!! - thanks in advance...
    Attached Files Attached Files

  9. #9
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    I was saying you could do something like this



    Option Explicit
    
    
    Sub test()
        Dim ws As Worksheet
        Dim rData As Range
        Dim aryData As Variant
        Dim r As Long
        
        Application.ScreenUpdating = False
        
        Set ws = Worksheets("main workbook")
    
    
        'row 6 formulas cleared
        Set rData = ws.Cells(7, 1).CurrentRegion
        
        aryData = rData.Value
    
        For r = LBound(aryData, 1) + 1 To UBound(aryData, 1)
            aryData(r, 11) = Empty
            aryData(r, 15) = Empty
            aryData(r, 16) = Empty
            aryData(r, 29) = Empty
            aryData(r, 30) = Empty
            aryData(r, 31) = Empty
            aryData(r, 32) = Empty
            aryData(r, 33) = Empty
            aryData(r, 34) = Empty
            
            If aryData(r, 1) = 0 Then GoTo NextRow
                
            '11 - =IF(A6="","",IF(G6="","Excellent",CONCATENATE(H6," ",J6)))
            aryData(r, 11) = IIf(Len(aryData(r, 7)) = 0, "Excellent", aryData(r, 8) & " " & aryData(r, 10))
            
            '15 - =IF(A6="","",DATE(YEAR(TODAY()),MONTH(TODAY()),1))
            aryData(r, 15) = DateSerial(Year(Now), Month(Now), 1)
            
            '16 - =IF(A6="","",DATE(YEAR(O6),MONTH(O6)+1,0))
            aryData(r, 16) = DateSerial(Year(Now), Month(Now) + 1, 0)
            
            
            '29 - =IF(A6="","",IF(OR(R6="first",R6="second",R6="third"),ROUND(Y6*1250%,2),ROUND(Y6*950%,2)))
            Select Case LCase(aryData(r, 18))
                Case "first", "second", "third"
                    aryData(r, 29) = Round(aryData(r, 25) * 12.5, 2)    '   not sure about your %
                Case Else
                    aryData(r, 29) = Round(aryData(r, 25) * 9.5, 2)
            End Select
            
            '30 - =IF(A6="","",ROUND(Y6*10/12,2))
            aryData(r, 30) = Round(aryData(r, 25) * 10 / 12, 2)
            
            
            '31 - =IF(A6="","",IF(OR(R6="first",R6="second"),CEILING(ROUNDDOWN(Q6*13%,2),0.5),CEILING(ROUNDDOWN(Q6*2.5%,2),0.5)))
            With Application.WorksheetFunction
                Select Case LCase(aryData(r, 18))
                    Case "first", "second"
                        aryData(r, 31) = .Ceiling(.RoundDown(aryData(r, 17) * 0.13, 2), 0.5)
                    Case Else
                        aryData(r, 31) = .Ceiling(.RoundDown(aryData(r, 17) * 0.025, 2), 0.5)
                End Select
            End With
            
            '32 - =IF(A6="","",IF(OR(X6="Excellent",X6="very good",X6="good"),Z6,AA6))
            Select Case LCase(aryData(r, 24))
                Case "excellent", "very good", "good"
                    aryData(r, 32) = aryData(r, 26)
                Case Else
                    aryData(r, 32) = aryData(r, 27)
            End Select
            
            
            '33 - =IF(A6="","",ROUND(Y6*10/12,2))
            aryData(r, 33) = Round(aryData(r, 25) * 10 / 12, 2)
            
            '34 - =IF(A6="","",IF(OR(X6="Excellent",X6="very good",X6="good"),ROUND(AB6*375%,2),""))
            Select Case LCase(aryData(r, 24))
                Case "excellent", "very good", "good"
                    aryData(r, 34) = Round(aryData(r, 28) * 3.75, 2)
            End Select
    NextRow:
        Next r
        
        rData.Value = aryData
        
        Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  10. #10
    Thanks a lot for your reply and kind help
    Regardless of the formulas used, whether complicated or uncomplicated
    The idea is to convert or replace these formulas to their values depending on many conditions through many drop-down lists
    The code works perfectly and it gives exact results .. the only problem is that it takes long time to execute.
    I welcome any ideas to improve the code, so any help at all would be massively appreciated!!!
    Last edited by jonsonbero; 05-24-2020 at 01:37 PM.

  11. #11
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    My macro takes about one second to do 10,000+ rows

    So if you're seeing 'long time to execute' the problem might be somewhere else??
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    idea of converting formulas to codes an excellent idea, But I will need more time and help, I think your time does not allow this.
    My question is what about my code? thanks a lot
    Last edited by jonsonbero; 05-24-2020 at 03:04 PM.

  13. #13
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    Well, I guess I'm not understanding where you want to go

    You can try this and see if it's more to your liking. Also takes about a second to run, but once the formulas are replaced with values, anything that depends on a Dropdown seems like it'd be wrong

    It seems like it has the same functional layout as your originally did


    Option Explicit
    
    
    Sub test2()
        
        Dim rAll As Range, rForm As Range, rData As Range, rFormulas As Range, rCell As Range
        
        Set rAll = ActiveSheet.Cells(6, 1).CurrentRegion
        Set rForm = rAll.Rows(1)
        Set rData = rAll.Cells(3, 1).Resize(rAll.Rows.Count - 2, rAll.Columns.Count)
        Set rFormulas = rForm.SpecialCells(xlCellTypeFormulas)
        
        Application.ScreenUpdating = False
        
        For Each rCell In rFormulas.Cells
            rCell.Copy rData.Columns(rCell.Column)
            rData.Columns(rCell.Column).Value = rData.Columns(rCell.Column).Value
        Next
        
        Application.CutCopyMode = False
    
    
        Application.ScreenUpdating = True
        
        MsgBox "Done"
    
    
    
    
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #14
    I thank u sincerely for your effort to help me
    First of all, thank you so much for your time. Really appreciate that.I tested it on the real data and it works fine. but takes 30 seconds.
    I think it would be worthwhile using arrays or using any alternative approach to speed this up. Because I deal with a lot of data.
    Is it possible to achieve that? your cooperation is highly appreciated.
    Last edited by jonsonbero; 05-25-2020 at 11:46 AM.

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,263
    Location
    Quote Originally Posted by Paul_Hossler View Post
    1. You're entitled to your opinion, even if it is wrong
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  16. #16
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    Quote Originally Posted by jonsonbero View Post
    I thank u sincerely for your effort to help me
    First of all, thank you so much for your time. Really appreciate that.I tested it on the real data and it works fine. but takes 30 seconds.
    I think it would be worthwhile using arrays or using any alternative approach to speed this up. Because I deal with a lot of data.
    Is it possible to achieve that? your cooperation is highly appreciated.

    My Example_4.xlsm 1) loads the raw data into an array, 2) calculates dependent values using VBA and not WS formulas, and then 3) puts the updated array back on the WS. 10,000+ rows in about 1 sec

    Were you looking for more than that?

    Downside is that the calculations done with WS formulas are now done with VBA so if the algorithm changed, you'd have to update the macro

    If some of the PARAMETERS changed (like 1150% instead of 1250%, and 900% instead of 950%) that could easily be handled without revising the macro
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  17. #17
    yes my tutor ... I am searching for more than that
    I am sure that this is possible, but I cannot find how to do this.
    Thanks a lot for sharing me my ideas. I learned something new from helping you with this

  18. #18
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    Well good luck with your "searching for more than that"

    The macros that have been posted here were based on all the information you provided (Example +2.xlsm with 22 rows of data) but will execute 10,000+ rows in about a second (Example4.xlsm) so it must be the other parts of your project that are taking time
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  19. #19
    In fact the words would not be enough to thank you .. You are really great personality, To be honest with you my tutor.
    Firstly : - Both example 4 & 5 They are greater than I imagined.
    Secondly : - The real file has about 95 columns with formulas and about 20,000 rows In addition to the auxiliary columns.
    my problem with Example4 is that I am trying to Convert the real formulas to codes, But I failed to achieve this with many formulas.
    As for your Code.... The code is working fine on the Sample attached as this is Sample but as for the real data, it takes approx 30 seconds to run,
    This is a great Accomplishment by comparing it with my code, this is your right, I can not say otherwise
    Really it is a problem ... I hope Success and good fortune be with all of you

  20. #20
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,326
    Location
    my problem with Example4 is that I am trying to Convert the real formulas to codes, But I failed to achieve this with many formulas.
    If you get stuck, this time provide a sample workbook with ALL the columns that have formulas, and only 10-20 rows of sample data and we can look at it again
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

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