unseen_rider
unseen_rider

Reputation: 324

Excel VBA How to make code more efficient and take less time

I have the following code below. I would like advice and suggestions on how it can be improved / rewrote to minimize;

1) Time taken 2) Number of operations

Presume all variables that are integer in code can be very large - eg each dim as Long, and > 0.

Purpose of code, is to count the number of tuples (a,b,c,d) for a solution to a mathematics question (https://math.stackexchange.com/questions/2093497/finding-number-of-coprime-tuples-from-1-to-n/2094773) stored in variable i, and storing each possible tuple (a,b,c,d) in Array_abcd().

** In particular, the slowest part seems to be the code under 'Calculate tuples for F(i,j)=1 stored in Array_u_Fij() - where I calculate the time complexity to be of Big-O n^5.** - This is now where I'm requesting help.

Function Modulo:

Function Modulo(x as long, y as long, p as long) as Long

Modulo = x * y mod p

End Function

Main Sub:

Sub Number_tuples()

'This is limited by the number of rows and column an 
'.xlsm file can have.
Application.screenupdating=false
Application.displayalerts=false
Application.calculation=xlcalculationmanual

Prime1=599
Prime2=601
p=Prime1 * Prime2

'Set up sheet 1
...
'Set up sheet 2
...

'Declare Array_Ints()
Redim Array_ints(4)

'Store list of integers to be given in question
'This can be any list of integers
Array_ints(0)=1
Array_ints(1)=10
Array_ints(2)=100
Array_ints(3)=1000

'Calculate N
N=Ubound(Array_ints)

'Declare array Array_nu_Fij()
Redim Array_nu_Fij(N,N,2)

'Calculate all non-unique Fij and store results in Array_nu_Fij(), and put matrix of nu_Fij values in sheet 1
...
Array_nu_Fij(i,j,0) = Modulo(a,b,p)
Array_nu_Fij(i,j,1) = Cstr(a) & "," & Cstr(b)
sht1.cells(i+2, j+1).value=Array_nu_Fij(i,j,0)
...

'Declare Array_u_Fij()
ReDim Array_Fij(N*N,3)

'Calculate all unique Fij
'Store uFij value in Array_u_Fij(o,0), and a_b in Array(o,1)
'Put a_b value in worksheet 2
...

'Put freq from worksheet 2 in Array_u_Fij()
...


'Calculate size of 1st col of Array_u_Fij()
lastrow_new_sht2= sht2.Cells(sht2.Rows.Count, "A"). End(xlUp).Row
startrow_sht2 = 3
size_u_Fij_1col = lastrow_new_sht2 - startrow_sht2 + 1

'Declare Array_abcd()
ReDim Array_abcd(N*N)

'Calculate tuples for F(i,j)=1 stored in Array_u_Fij()
i=0
For m = 0 to size_u_Fij_1col - 1
    'Store current u_Fij and freq being considered
    u_fij_1= Array_u_Fij(m,0)
    Freq = Array_u_Fij(m,1)
    a_b = Array_u_Fij(m,2)
    c_d = ""
        While freq > 1
            'First compare u_Fij_1 with current u_Fij_1
            For freq_gt_1 = 2 to freq
                'Check if u_Fij_1 = 1
                If u_fij_1 = 1 then
                    dblGCD = 1
                    i = i +1
                    Array_abcd(m)= Array_abcd(m) & "||" & a_b
                Else
                    'GCD of u_Fij_1 with other u_Fij_1
                    dblGCD = u_Fij_1
                    If dblGCD = 1 then
                        i = i + 1
                        Array_abcd(m)= Array_abcd(m) & "||" & a_b
                    Else
                    End if
                End if
            Next freq_gt_1

            '2nd compare u_Fij_1 with u_Fij_2<>u_Fij_1
            For q = 1 to lastrow_sht2
                If m+q >= size_u_Fij_1col then
                     'Array_u_Fij(m+q) doesn't exist
                     'Hence no need to check
                Else
                    u_Fij_2 = Array_u_Fij(m+q+1,0)
                    freq_other = Array_u_Fij(m+q+1,1)
                    c_d = Array_u_Fij(m+q+1,2)
                    'Only consider freq_other > 0
                    While freq_other > 0
                        if u_Fij_1 =1 then
                            'GCD is 1
                            dblGCD = 1
                            Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d
                            i = i + 1
                       Elseif u_Fij_1 = u_Fij_2 then
                             dblGCD = u_Fij_1
                             If dblGCD = 1 then
                                 i = i + 1
                                 Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d                                 
                             Else
                             End if
                        Elseif u_fij_2 = 1 then
                             dblGCD = 1
                             i = i +1
                             Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d 
                        Else
                             dblGCD = Application.WorksheetFunction.GCD(u_Fij_1,u_Fij_2)
                             If dblGCD = 1 then
                                 i = i + 1
                                 Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d                                 
                             Else
                             End if
                    Else 
                    End if
                    Freq_other = freq_other - 1
                Wend
            End if
        Next q
        Freq=freq - 1
    Wend

    While freq=1
         'Compare a=u_Fij_1 with b=u_Fij_2<>1
         For q = 0 To size_uFij_1col
             'Check if m+q is equal to or larger than size of 
             'array
             If m+q >= size_uFij_1col then
                 'Do nothing
             Else
                 If u_fij_1 = 1 then
                     dblGCD = 1
                     Array_abcd(m)=Array_abcd(m) & "||" & a_b & "," & c_d
                     i= i+1
                 Else
                     'u_Fij_1 <>1. Now need to consider freq of other u_Fij_2=b<>a
                     u_Fij_2 = Array_u_Fij(m+q+1,0)
                     freq_other=Array_uFij(m+q+1,1)
                     c_d=Array_uFij(m+q+1,2)
                     'Only consider freq_other > 0
                     While freq_other > 0
                         'Check if u_Fij_2 =1
                         If u_Fij_2 = 1 then
                             'GCD is 1
                             Array_abcd(m)=Array_abcd(m) & "||" & a_b & "," & c_d
                             i = i + 1
                         Else
                             'Need to determine GCD
                             dblGCD = Application.WorksheetFunction.GCD(u_Fij_1,u_Fij_2)
                             If dblGCD = 1 then
                                 I = I+ 1
                                 Array_abcd(m)=Array_abcd(m) & "||" & a_b & "," & c_d
                             Else
                             End if             
                         End if
                         Freq_other = Freq_other - 1
                     Wend
                     End if
             End if
        Next q
        Freq=freq - 1
    Wend
Next m

Application.screenupdating=true
Application.displayalerts=true
Application.calculation=xlcalculationautomatic

End Sub

Upvotes: 0

Views: 673

Answers (2)

rdnobrega
rdnobrega

Reputation: 789

Also, you can disable calculation and screenupdating during your operation with this at the beginning of your code:

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

And at the end, turn back to normal:

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

Be careful with macro crashes. Remember to put it back to normal those variables when the crash happens.

Upvotes: 1

Carl Colijn
Carl Colijn

Reputation: 1607

Without exactly knowing your data, nor how big it may be, it might be optimized by fetching all data needed in one go into VBA arrays.

Your code basically fetches the .Value over and over again from the cells in column 1 and 2. Every time you cross the VBA/Excel border like this you pay a (small) overhead cost, but paying that price too many times does add up.

Instead try to fetch the data in columns 1 and 2 only once, and work from these arrays instead. Like e.g.:

Dim col1Values As Variant
col1Values = sht2.Range(sht2.Cells(1, 1), sht2.Cells(lastrow_sht2, 1)).Value
Dim col2Values As Variant
col2Values = sht2.Range(sht2.Cells(1, 2), sht2.Cells(lastrow_sht2, 2)).Value

and from then on not use sht2.Cells(m, 1).Value anymore but col1Values(m, 1). (note that the arrays Excel returns here are 2-dimensional arrays, where the 1st index is the row and the 2nd the column.)

Upvotes: 1

Related Questions