Run several Fast Fourier Transformations in a row

[BEADG]

Hi guys,

Recently I had to calculate some data with Fast Fourier Transformation (FFT).
At the beginning I used data analysis toolpak in the worksheet directly which worked.
since I have to do it quite often in thenext time I tried to do it in VBA.
The Macro works just fine basically.
I always get a set of 30 test runs which I analyze.The macro I have works and is also fast enough.
But I know it is just super complicatedwhat I did for no reason
Can you help me to find a more clever wayto write the macro and also to make it flexible in case I have 28 or 32datasets and not exactly 30?
What I have is that (I cut it after 5^thrun as it is super long otherwise):

Sub CalcFFT512()
'
' CalcFFT with 512 samples
On Error GoTo ExitNow
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'1
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$D$8:$D$519") _
, ActiveSheet.Range("$AI$8"), False, False
'2
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$E$8:$E$519") _
, ActiveSheet.Range("$AL$8"), False, False
'3
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$F$8:$F$519") _
, ActiveSheet.Range("$AO$8"), False, False
'4
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$G$8:$G$519") _
, ActiveSheet.Range("$AO$8"), False, False
'5 and so on....

ExitNow:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Any good idea?

Best regards
Steffen

[Jan Karel Pieterse]

SHouldn't that be:

'1
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$D$8:$D$519") _
, ActiveSheet.Range("$AI$8"), False, False
'2
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$E$8:$E$519") _
, ActiveSheet.Range("$AL$8"), False, False
'3
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$F$8:$F$519") _
, ActiveSheet.Range("$AO$8"), False, False
'4
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range("$G$8:$G$519") _
, ActiveSheet.Range("$AR$8"), False, False

[offthelip]

Assuming the layout of the rest is consistent and you can do it in a loop like this:

For i = 0 To 29
Application.Run "ATPVBAEN.XLAM!Fourier", ActiveSheet.Range(Cells(8, 4 + i), Cells(519, 4 + i)) _
, ActiveSheet.Range(Cells(8, 35 + (i * 3)), Cells(8, 35 + (i * 3))), False, False
Next i

you can the set the loop using a value in a cell or user input

[snb]

Sub M_snb()
  sn = Sheet1.Cells(8, 4).CurrentRegion
    
  For j = 0 To UBound(sn, 2) - 1
    Application.Run "ATPVBAEN.XLAM!Fourier", Sheet1.Range("$D$8:$D$519").Offset(, j), Sheet1.Cells(8, 35 + j)
  Next
End Sub

[Paul_Hossler]

Since I know how much trouble I have going back to a macro after a time, I opt for the wordy, self documenting approach

Option Explicit

Sub CalcFFT512()
    Dim rData As Range, rData1 As Range, rCol As Range, rAnswer As Range
    
    'On Error GoTo ExitNow
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set rData = ActiveSheet.Range("$D$8")
    Set rData1 = rData.End(xlDown)
    Set rData = Range(rData, rData1.End(xlToRight))
    
    Set rAnswer = ActiveSheet.Range("$AI$8")
    
    For Each rCol In rData.Columns
        Application.Run "ATPVBAEN.XLAM!Fourier", rCol, rAnswer, False, False
        Set rAnswer = rAnswer.Offset(0, 3)
    Next

ExitNow:
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub

[BEADG]

Guys you are amazing!

The solutions work perfect in is just so much more convenient now
I added a function to clear the result are prior to FFT calculation and that’s it.

Thanks a lot!