Improve Efficiency of VBA Code

[jonsonbero]

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-programming-vba-macros/1316270-improve-efficiency-of-vba-code.html


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

[jonsonbero]

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

[offthelip]

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.

[macropod]

Cross-posted - and given extensive help before posting here - at: https://www.excelforum.com/excel-programming-vba-macros/1316270-improve-efficiency-of-vba-code.html
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

[Paul_Hossler]

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

[snb]

@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

[Paul_Hossler]

@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

[jonsonbero]

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

[Paul_Hossler]

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

[jonsonbero]

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

[Paul_Hossler]

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

[jonsonbero]

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

[Paul_Hossler]

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

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

[Bob Phillips]

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

[Paul_Hossler]

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

[jonsonbero]

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

[Paul_Hossler]

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

[jonsonbero]

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

[Paul_Hossler]

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

[jonsonbero]

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

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.

[Paul_Hossler]

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