Optimize VBA Macro Summing Code

Re: Optimizing Sum Speed

What is the code supposed to do?

Re: Optimize Inneficient VBA Macro Sum Code

hi,blackjack

Sub macrotest()
Dim suma As Double
Dim data
data = Range("thousandtest")
suma = 0
n = UBound(data, 1)
k = 1  
    For ki = k To n
        For kj = k To n
            suma = Abs(data(ki, 1) - data(kj, 1)) + suma    
        Next kj
        Next ki
Range("f1").Offset(3).Value = suma
End Sub

regards/junho lee

Re: Optimize Inneficient VBA Macro Sum Code

what blackjack is trying to do is following:

∑∑|Ai – Aj| with first summation is from 1 to count of row(1000) and second summation is also from 1 to count or row (1000)

for 3 rows its like
suma = |A1-A1| + |A1-A2| + |A1-A3|+ |A2-A1| + |A2-A2|+ |A2-A3| + |A3-A1| + |A3-A2| + |A3-A3|

Small knowledge of Maths can help us to reduce time

As |A1-A2| = |A2-A1|

Suma = 2 * ∑∑|Ai – Aj| where i goes from 1 to 1000 while j goes from i+1 to 1000

so for 3 row it will be

suma = 2 * (|A1-A2| + |A1-A3|+|A2-A3|)

Hope the logic is clear

So the new code will be

Sub macrotest()
Dim suma As Double
suma = 0
n = Range("thousandtest").Count


  For i = 1 To n


        For j = i To n
       
            suma = Abs(Range("a1").Offset(i) - Range("a1").Offset(j)) + suma


            
        Next j
        Next i


suma = suma * 2
Range("f1").Offset(2).Value = suma


End Sub

Hope this reduces time by 50% as 9 calculations initally has been reduced to 4

there is nothing wrong in coding but blackjack was trying to do it hard way!!!
espere que yo acertara blackjack

Re: Optimize Inneficient VBA Macro Sum Code

One thing that speeds up the code is to process the data in memory, rather than reading from the sheet:

Sub macrotest_speed_up()


    Dim suma    As Double
    Dim data()  As Variant
    Dim i       As Long
    Dim j       As Long
    
    data = WorksheetFunction.Transpose(ActiveSheet.Range("namedefinedformydata"))
    
    For i = LBound(data) To UBound(data)
        For j = i + 1 To UBound(data)
            suma = Abs(data(i) - data(j)) + suma
        Next j
    Next i
    
    ActiveSheet.Range("f1").Offset(3).Value = (suma * 2)
    
    Erase data()
    
End Sub

It still doesn't scale too well, but processes 10 000 integer entries in ~10 seconds on my PC.

What's your data like? Small integers, floating point numbers etc? There might be some additional optimization we could base on that.

Re: Optimize Inefficient VBA Macro Sum Code

Minor correction:

For i = LBound(data) To UBound(data) - 1

... though it won't change the result, because the inside loop won't execute when i = UBound(data)

Re: Optimize Inefficient VBA Macro Sum Code

Quote

Any idea how to solve this issue?

Don't save as multi-earlier versions. Save as *.xlsm (2007 macro enabled Workbook).

Re: Optimize VBA Macro Summing Code

How do you know which result is correct?

Re: Optimize VBA Macro Summing Code

Quote from Dave Hawley

How do you know which result is correct?

Because the sum with the 68.000 numbers is much faster and give a much smaller number than the one with 67.000 numbers, which is impossible. 1.2342e11 compared with 1.4546e14.

With the original code (not optimized) the sum is bigger with the 68.000 number than with 67.000.

Re: Optimize VBA Macro Summing Code

Like Anupam Shrivastava said.

Sub macrotest_speed_up()
     
    Dim suma    As Double
    Dim data1()  As Variant
    Dim data2()  As Variant
    Dim i       As Long
    Dim j       As Long
    Dim r As Long
    Dim r1 As Long
    
    r = Range("namedefinedformydata").Rows.Count
    r1 = Int(r / 2)


    data1 = WorksheetFunction.Transpose(ActiveSheet.Range(Range("namedefinedformydata").Cells(1), Range("namedefinedformydata").Cells(r1)))
    data2 = WorksheetFunction.Transpose(ActiveSheet.Range(Range("namedefinedformydata").Cells(r1 + 1), Range("namedefinedformydata").Cells(r)))
 
    For i = LBound(data1) To UBound(data1) - 1
        For j = i + 1 To UBound(data1)
            
            suma = Abs(data1(i) - data1(j)) + suma
        Next j
    Next i
   
     For i = LBound(data2) To UBound(data2) - 1
        For j = i + 1 To UBound(data2)
            suma = Abs(data2(i) - data2(j)) + suma
        Next j
    Next i
    
     For i = LBound(data1) To UBound(data1)
        For j = LBound(data2) To UBound(data2)
            suma = Abs(data1(i) - data2(j)) + suma
        Next j
    Next i
     
    ActiveSheet.Range("f1").Offset(3).Value = (2 * suma)
     
    Erase data1()
    Erase data2()
End Sub

Re: Optimize VBA Macro Summing Code

The last code works perfect!!! what was the problem i don't get it??
BlackJack it work very very fast!! and give the same number!!!