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.

I have posted at this link too https://www.excelforum.com/excel-pro...-vba-code.html

please see what I have so far. Thanks in advance.

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

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.

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

Quote:

---

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

Code:

---

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

---

@PH

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

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

---

Quote:

---

Originally Posted by snb

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

Quote:

---

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

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.

Code:

---

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

I was saying you could do something like this

Code:

---

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

---

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!!!

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??

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

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

Code:

---

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

---

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.

Quote:

---

Originally Posted by Paul_Hossler

1. You're entitled to your opinion, even if it is wrong

---

:clap::clap:

Quote:

---

Originally Posted by jonsonbero

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

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

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

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

Quote:

---

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

Many thanks M. Paul_Hossler for your time again.
Another try
I have written the code below It is working well but it takes too long time althought I used arrays
but After testing the code on the original file. It gave me a run-time error '13' a type mismatch In this line

Code:

---

    Let arrOut() = Application.Index(arrIn(), Rws(), Clms())

---

What are the reasons about this error? In your view sir
I apologize for my question. but I trying to figure this out for a few hours and can no longer the thinking.
Appreciate your help and thank you in advance.

I don't get an error and the results seem to be OK

I did restructure your macro a little so that I could single step through it