Related
I have the below VBA code which calculates a number of output values and stores them in as an array (beginning_gross_facility_balance being one of the examples).
when I try to print the resulting array values into excel (to output2 range, which is C16:J515 in an excel tab, the array is exported/printed into column D and from row 17.
currently, i = 1 and j = 25
grateful if someone could shine some light on why this is happening/how can I ensure that the output is copied into the first column and first row of the range
Sub AssetProjection2()
Application.ScreenUpdating = False
'pluming variables
Dim i As Integer
Dim j As Integer
Dim Period As Integer
Dim numberOfLoans As Integer
numberOfLoans = WorksheetFunction.CountA(Range("LoanCount")) - 1
ReDim tape(numberOfLoans)
Dim pool_lag As Double
Dim total_gross_facility_limit As Double
Dim beginning_gross_facility_balance(500, 500) As Double
Dim interest_rate As Double
Dim arrangement_fee As Double
Dim admin_fee As Double
Dim Audit_fee As Double
Dim insurance_fee As Double
Dim exit_fee As Double
Dim loan_term As Double
Dim loan_remaining_term As Double
Dim default_flag As String
Dim GDV As Double
'only relevant for loans with no seasoning
Dim first_tranche_percentage As Double
Dim seasoning As Double
Dim adjustment_factor As Double
Dim development_fees As Double
Dim lag As Double
Dim sev As Double
'temps/ output variables on a loan by loan basis (so i can call info from any period and any loan)
Dim pmt As Double
Dim Recovery As Double
Dim TempDefault(500, 500) As Double
'end of period balance is the cumulative gross facility at any given point, at maturity, this should match total gross loan limit
Dim end_of_period_gross_balance(500, 500) As Double
Dim periodic_interest(500, 500) As Double
Dim cumulative_retained_interest(500, 500) As Double
Dim periodic_gross_drawdown(500, 500) As Double
Dim periodic_net_advance(500, 500) As Double
Dim cumulative_net_advance(500, 500) As Double
'the loan redeems in one go, then principal and interest redemptions are split for transparency
Dim total_facility_repayment(500, 500) As Double
Dim principal_redemption(500, 500) As Double
Dim interest_redemption(500, 500) As Double
'pristine/stressed variables
Dim prin As Double
Dim prepay As Double
'scenarios
Dim DefScen As Integer
Dim PrepScen As Integer
Dim SevScen As Integer
Dim LagScen As Integer
Dim IRScen As Integer
'ouput variables
'the below is currently not being used
Dim oBegBalance(500) As Double
Dim oEndBalance(500) As Double
Dim oDefault(500) As Double
Dim oInterest(500) As Double
Dim oPrincipal(500) As Double
Dim oPrepayment(500) As Double
Dim oRecovery(500) As Double
Dim oAccrued(500) As Double
Dim oCumTheoreticalDef(500) As Double
'initialise CF time
Period = 1
pool_lag = Range("total_lag").Value
'this loop will project asset cashflows assuming non-seasonality, then the next loop will look-up the figures for each loan based on the loan's seasonality
For i = 1 To numberOfLoans
SevScen = Range("severity_scen").Cells(i + 1)
LagScen = Range("lag_scen").Cells(i + 1)
'IR scenario currently not in use, when floating interest is modelled, this will be already plugged in
IRScen = Range("IR_scen").Cells(i + 1)
interest_rate = Range("interest_rate").Cells(i + 1)
loan_remaining_term = Range("loan_remaining_term").Cells(i + 1)
loan_term = Range("loan_term").Cells(i + 1)
seasoning = loan_term - loan_remaining_term
first_tranche_percentage = Range("first_tranche_percentage").Cells(i + 1)
total_gross_facility_limit = Range("total_gross_limit").Cells(i + 1)
adjustment_factor = 1.1
admin_fee = Range("admin_fee").Cells(i + 1)
default_flag = Range("default_flag").Cells(i + 1)
For j = 1 To loan_term + pool_lag
lag = Range("LagScenarios").Cells(loan_term + j + 4, LagScen)
sev = Range("severityScenarios").Cells(loan_term + j + 4, SevScen)
If j = 1 Then
arrangement_fee = Range("arrangement_fee").Cells(i + 1)
Audit_fee = Range("Audit_fee").Cells(i + 1)
insurance_fee = Range("insurance_fee").Cells(i + 1)
Else
arrangement_fee = 0
Audit_fee = 0
insurance_fee = 0
End If
If j = loan_term Then
exit_fee = Range("exit_fee").Cells(i + 1)
Else
exit_fee = 0
End If
development_fees = arrangement_fee + Audit_fee + insurance_fee + admin_fee
Recovery = 0
'term is original term, not really used anywhere at the moment, only as a static figure to work out seasonality for input curves
loan_term = Range("loan_term").Cells(i + 1)
'remaining term doesnt need to be dynamic as the PMT formula takes the current J into account to work out the dynamic remaining term
loan_remaining_term = Range("loan_remaining_term").Cells(i + 1)
interest_rate = Range("interest_rate").Cells(i + 1)
If j = 1 Then
beginning_gross_facility_balance(i, j) = total_gross_facility_limit * first_tranche_percentage
Else
beginning_gross_facility_balance(i, j) = end_of_period_gross_balance(i, j - 1)
End If
'gross drawdown. if first disbursment, it's first_tranche_percentage, else, it's a fixed figure such that from month 2 to maturity, the total gross facility equals the gross loan limit. for the model, I will start with a basic number and learn how to apploy a goal seek/solver figure
'draws happen at the beginning of the period and so every period's accrued interest is on the end of period balance J - 1 + period J further draw (J=1 has end of previous period as 0 bcs the loan is new
If j = 1 Then
periodic_gross_drawdown(i, j) = 0
Else
If j < loan_term Then
periodic_gross_drawdown(i, j) = (total_gross_facility_limit - periodic_gross_drawdown(i, 1)) / (loan_term - 2) / adjustment_factor
Else
periodic_gross_drawdown(i, j) = 0
End If
End If
If j = 1 Then
periodic_net_advance(i, j) = beginning_gross_facility_balance(i, j) - development_fees
Else
periodic_net_advance(i, j) = periodic_gross_drawdown(i, j) - development_fees
End If
If j = 1 Then
cumulative_net_advance(i, j) = periodic_net_advance(i, j)
Else
cumulative_net_advance(i, j) = cumulative_net_advance(i, j - 1) + periodic_net_advance(i, j)
End If
periodic_interest(i, j) = (beginning_gross_facility_balance(i, j) + periodic_gross_drawdown(i, j)) * interest_rate
end_of_period_gross_balance(i, j) = beginning_gross_facility_balance(i, j) + periodic_interest(i, j)
If j = loan_term And default_flag = "N" Then
total_facility_repayment(i, j) = end_of_period_gross_balance(i, j)
principal_redemption(i, j) = cumulative_net_advance(i, j)
interest_redemption(i, j) = total_facility_repayment(i, j) - principal_redemption(i, j)
Else
total_facility_repayment(i, j) = 0
principal_redemption(i, j) = 0
interest_redemption(i, j) = 0
End If
If j = loan_term + lag And default_flag = "Y" Then
Recovery = total_facility_repayment(i, j - lag) * (1 - sev) 'accrue some defaulted int rate or keep it simple?
Else
Recovery = 0
End If
Next j
Next i
'write it out
'Range("beginning_balance_output") = WorksheetFunction.Transpose(beginning_gross_facility_balance)
Range("output2") = WorksheetFunction.Transpose(beginning_gross_facility_balance)
' Range("output2").Columns(3) = WorksheetFunction.Transpose(periodic_net_advance)
'Range("output2").Columns(4) = WorksheetFunction.Transpose(cumulative_net_advance)
' Range("output2").Columns(5) = WorksheetFunction.Transpose(total_facility_repayment)(end_of_period_gross_balance)
End Sub
Your problem is that you don't declare the lower bound of the arrays. Per default, VBA set the lower bound to 0, but you don't use the 0th row and/or column in your code.
If you write Dim TempDefault(500, 500) As Double, the 500 is used as upper bound, giving you an array of 501 x 501 (from 0 to 500) elements.
You can do the following:
(a) Declare the arrays like this:
Dim TempDefault(1 to 500, 1 to 500) As Double
(b) Rewrite your code to that it deals with the 0-row and column of the array
(c) Put the following statement at the top of the module:
Option Base 1
That will force the compiler to use 1 as lower bound if omitted at the declaration.
I would advice to use the first option and always declare the lower and upper bounds.
I have of integers in Col A and in col B i want to show result 'Prime' if it doesn't have further factors for the number itself. This goes like this if the number for example is 37 result will be 'Prime' and if its 44 then result will be 2x2x11. How can i do this using excel formula? Screen shot :
Disclaimer: code below is ported from this very useful VB.NET example
Option Explicit
Sub Test()
Debug.Print FindFactors(2)
Debug.Print FindFactors(3)
Debug.Print FindFactors(11)
Debug.Print FindFactors(12)
Debug.Print FindFactors(13)
Debug.Print FindFactors(16)
Debug.Print FindFactors(17)
Debug.Print FindFactors(24)
Debug.Print FindFactors(25)
Debug.Print FindFactors(11234)
Debug.Print FindFactors(67894)
End Sub
Function FindFactors(lngNumber As Long) As String
Dim collFactors As Collection
Dim lngFactor As Long
Dim lngCounter As Long
Dim strFactors As String
Dim strFactor As String
Set collFactors = New Collection
' Take out the 2s.
Do While (lngNumber Mod 2 = 0)
collFactors.Add 2
lngNumber = lngNumber / 2
Loop
' Take out other primes.
lngFactor = 3
Do While (lngFactor * lngFactor <= lngNumber)
If (lngNumber Mod lngFactor = 0) Then
' This is a factor.
collFactors.Add lngFactor
lngNumber = lngNumber / lngFactor
Else
' Go to the next odd number.
lngFactor = lngFactor + 2
End If
Loop
' If num is not 1, then whatever is left is prime.
If lngNumber > 1 Then
collFactors.Add lngNumber
End If
' make a string out of collection
strFactors = ""
If collFactors.Count = 1 Then
strFactors = "Prime"
Else
For lngCounter = 1 To collFactors.Count
strFactors = strFactors & collFactors(lngCounter)
If lngCounter < collFactors.Count Then
strFactors = strFactors & "x"
End If
Next lngCounter
End If
FindFactors = strFactors
End Function
Gives an output of:
Prime
Prime
Prime
2x2x3
Prime
2x2x2x2
Prime
2x2x2x3
5x5
2x41x137
2x83x409
Can be used in a worksheet:
Here is a somewhat straightforward recursive version. It is based on the idea that once you identify a factor you divide the number by that factor and then turn your attention to factoring the rest.
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "x" & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
Output:
Using LET and dynamic arrays allows for the following without VBA.
=LET(x, SEQUENCE(A1),
factors, FILTER(x, MOD(A1,x) = 0),
factorMatrix, 1 * (MOD(factors, TRANSPOSE(factors)) = 0),
primeFactors, FILTER(factors, MMULT(factorMatrix, factors ^ 0) = 2),
primeFactorList, IF(MOD(A1, primeFactors ^ SEQUENCE(1, 20)) = 0, primeFactors, ""),
factorProduct, TEXTJOIN("x",, primeFactorList),
IF(A1 = 1, "Neither", IF(factorProduct=A1&"","Prime",factorProduct)))
It works for numbers up to 2^20.
A slight modification to the excellent code of John Coleman above, using Mod with Doubles included below, will allow factoring integers up to Excel's 15 digit limit. Numbers with large factors may be noticeably slower. For example, 562,951,983,465,953 factored correctly as 16,777,259 x 33,554,467 in about 5 seconds on a Core i3.
Function Factor(ByVal n As Double, Optional FirstTrial As Double = 2) As String 'Changed
Dim i As Long
Dim t As Double 'Changed
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If FMod(t, n) = 0 Then 'Changed
.
.
.
Public Function FMod(a As Double, b As Double) As Double
FMod = a - Fix(a / b) * b
'http://en.wikipedia.org/wiki/Machine_epsilon
'Unfortunately, this function can only be accurate when `a / b` is outside [-2.22E-16,+2.22E-16]
'Without this correction, FMod(.66, .06) = 5.55111512312578E-17 when it should be 0
If FMod >= -2 ^ -52 And FMod <= 2 ^ -52 Then '+/- 2.22E-16
FMod = 0
End If
End Function
I am trying to write an FFT application in Excel that claculates frequencies, amplitude and phase. I know how to use the in-built function but the data I am trying to analyse has 32,795 points, more than the maximum 4096 for the in-buit function.
Does anyone know how I can either (1) Increase the maximum number of data inputs? (2) Write my own macro to avoid using the in-built function (if this allows me to analyse all the points)? or (3) Start over in Matlab or a with programming language that allows me to analyse all the points and get all the data I need?
You can easily use the matlab built in function and it doesnt have the limitation like Excel and then import the results to excel
Yes, Excel FFT has the limit of data point 4096 and slow.
I programmed FFT using only Excel VBA code and there is no limit of the data point.
Below is the performance for the data point count.
There was a part where I could speed it up a bit, but I didn't b/c it makes the code less readable. However, even now, it may be the fastest FFT code in the Excel.
[data point] [FFT execution time]
4 kB 62ms
16 kB 235ms
64 kB 984ms
Computer Specification: 11th Gen Intel(R) Core(TM) i7-1165G7 # 2.80GHz
I implemented Cooley-Tukey algorithm, and use several techniques to speed-up the code running time in the Excel environment.
You can find the code and download the excel file in here. (https://infograph.tistory.com/351)
Otherwise you can review main logic as below:
'Module: fftProgram
'Author: HJ Park
'Date : 2019.5.18(v1.0), 2022.8.1(v2.0)
Option Explicit
Public Const myPI As Double = 3.14159265358979
Public Function Log2(X As Long) As Double
Log2 = Log(X) / Log(2)
End Function
Public Function Ceiling(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
' X is the value you want to round
' Factor is the multiple to which you want to round
Ceiling = (Int(X / Factor) - (X / Factor - Int(X / Factor) > 0)) * Factor
End Function
Public Function Floor(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
' X is the value you want to round
' Factor is the multiple to which you want to round
Floor = Int(X / Factor) * Factor
End Function
' return 0 if N is 2^n value,
' return (2^n - N) if N is not 2^n value. 2^n is Ceiling value.
' return -1, if error
Public Function IsPowerOfTwo(N As Long) As Long
If N = 0 Then GoTo EXIT_FUNCTION
Dim c As Long, F As Double
c = Ceiling(Log2(N)) 'Factor=0, therefore C is an integer number
F = Floor(Log2(N))
If c = F Then
IsPowerOfTwo = 0
Else
IsPowerOfTwo = (2 ^ c - N)
End If
Exit Function
EXIT_FUNCTION:
IsPowerOfTwo = -1
End Function
''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''
Function MakePowerOfTwoSize(ByRef r As Range, ByVal fillCount As Long) As Boolean
Dim arr() As Integer
On Error GoTo ERROR_HANDLE
'1)make a array with zero
ReDim arr(0 To fillCount - 1) As Integer
'2)set a range to be filled with zero
Dim fillRowStart As Long
Dim fillRange As Range
fillRowStart = r.Row + r.Rows.Count
Set fillRange = Range(Cells(fillRowStart, r.Column), Cells(fillRowStart + fillCount - 1, r.Column))
'3)fill as zero
fillRange = arr
'4)update range area to be extended
Set r = Union(r, fillRange)
MakePowerOfTwoSize = True
Exit Function
ERROR_HANDLE:
MakePowerOfTwoSize = False
End Function
' read the range and return it as complex value array
Function Range2Array(r As Range) As Complex()
Dim i As Long, size As Long
Dim arr() As Complex
size = r.Rows.Count
ReDim arr(0 To size - 1) As Complex
Dim re As Double, im As Double
On Error GoTo ERROR_HANDLE
For i = 1 To size
arr(i - 1) = String2Complex(r.Rows(i).Value)
Next i
Range2Array = arr
Exit Function
ERROR_HANDLE:
MsgBox "Error: " & i
End Function
Function ArrangedNum(num As Long, numOfBits As Integer) As Long
Dim arr() As Byte
Dim i As Integer, j As Integer
Dim k As Long
If (2 ^ numOfBits) <= num Then GoTo EXIT_FUNCTION
'1) Decimal number -> Reversed Binary array : (13,4) -> {1,1,0,1} -> {1,0,1,1}
ReDim arr(0 To numOfBits - 1) As Byte
For i = 0 To numOfBits - 1
j = (numOfBits - 1) - i
k = Int((num / (2 ^ j)))
arr(j) = (k And 1)
Next i
'2) Reversed Binary -> Decimal: {1,0,1,1} -> 1*2^3 + 0*2^2 + 1*2&1 + 1 = 11
Dim d As Long
For i = 0 To numOfBits - 1
d = d + (arr(i) * 2 ^ (numOfBits - 1 - i))
Next i
ArrangedNum = d
Exit Function
EXIT_FUNCTION:
ArrangedNum = 0
End Function
' rangeArr[1 to n, 1]
Function arrangeToFFTArray(arr() As Complex, size As Long, numOfBits As Integer) As Complex()
Dim i As Long, j As Long
Dim arrangedArr() As Complex
ReDim arrangedArr(0 To size - 1) As Complex
For i = 0 To size - 1
j = ArrangedNum(i, numOfBits) '{000,001,010, 011, 100, 101, 110, 111} -> {0, 4, 2, 6, 1, 5, 3, 7}
arrangedArr(j) = arr(i)
Next i
arrangeToFFTArray = arrangedArr
End Function
' calculate convolution ring W
' W[k] = cos(theta) - isin(theta)
' theta = (2pi*k/N)
Function CalculateW(cnt As Long, isInverse As Boolean) As Complex()
Dim arr() As Complex
Dim i As Long
Dim T As Double, theta As Double
Dim N As Long, N2 As Long
N = cnt
N2 = N / 2
ReDim arr(0 To N2 - 1) As Complex 'enough to calculate 0 to (N/2 -1)
T = 2 * myPI / CDbl(N)
If isInverse Then
For i = 0 To N2 - 1
theta = -(T * i)
arr(i) = Cplx(Cos(theta), -Sin(theta))
Next i
Else
For i = 0 To N2 - 1
theta = T * i
arr(i) = Cplx(Cos(theta), -Sin(theta))
Next i
End If
CalculateW = arr
End Function
' X({0,1}, [0,n-1]): 2d array. (0, n) <--> (1,n)
' src: src index of the array. 0 or 1
' tgt: tgt index of the array. 1 or 0
' s : starting index of the data in the array
' size: region size to be calculated
' kJump : k's jumping value
' W(0 ~ n-1) : Convolution ring
Sub RegionFFT(X() As Complex, src As Integer, tgt As Integer, _
s As Long, size As Long, kJump As Long, W() As Complex)
Dim i As Long, e As Long
Dim half As Long
Dim k As Long
Dim T As Complex
' Xm+1[i] = Xm[i] + Xm[i+half]W[k]
' Xm+1[i+half] = Xm[i] - Xm[i+half]W[k]
k = 0
e = s + (size / 2) - 1
half = size / 2
For i = s To e
T = CMult(X(src, i + half), W(k))
X(tgt, i) = CAdd(X(src, i), T)
X(tgt, i + half) = CSub(X(src, i), T)
k = k + kJump
Next i
End Sub
Sub WriteToTarget(tgtRange As Range, X() As Complex, tgtIdx As Integer, N As Long, roundDigit As Integer)
Dim i As Long
Dim arr() As Variant
ReDim arr(0 To N - 1) As Variant
For i = 0 To N - 1
If X(tgtIdx, i).im < 0 Then
arr(i) = Round(X(tgtIdx, i).re, roundDigit) & Round(X(tgtIdx, i).im, roundDigit) & "i"
Else
arr(i) = Round(X(tgtIdx, i).re, roundDigit) & "+" & Round(X(tgtIdx, i).im, roundDigit) & "i"
End If
Next i
tgtRange.Rows = Application.Transpose(arr)
End Sub
' xRange: input data
' tgtRange: output range
' isInverse: FFT or IFFT
Public Function FFT_Forward(xRange As Range, tgtRangeStart As Range, roundDigit As Integer, isInverse As Boolean) As Complex()
Dim i As Long, N As Long
Dim totalLoop As Integer, curLoop As Integer 'enough as Integer b/c it is used for loop varoable
Dim xArr() As Complex, xSortedArr() As Complex
Dim W() As Complex 'convolution ring
Dim X() As Complex 'output result
Dim errMsg As String
errMsg = "Uncatched error"
'1) check whether 2^r count data, if not pad to zero
Dim fillCount As Long
N = xRange.Rows.Count
fillCount = IsPowerOfTwo(N)
If fillCount = -1 Then
errMsg = "No input data. Choose input data"
GoTo ERROR_HANDLE
End If
If fillCount <> 0 Then
If MakePowerOfTwoSize(xRange, fillCount) = False Then 'xRange's size will be chnaged
errMsg = "Error while zero padding"
GoTo ERROR_HANDLE
End If
End If
'2) calculate loop count for FFT: 2->1 4->2 8->3 ...
N = xRange.Rows.Count 'xRange's size can be changed so read one more...
totalLoop = Log2(N)
'3) sort x for 2's FFT : convert to reversed binary and then convert to decimal
xArr = Range2Array(xRange) 'xArr[0,n-1]
xSortedArr = arrangeToFFTArray(xArr, N, totalLoop) 'xSortedArr[0,n-1]
'4) calculate W
W = CalculateW(N, isInverse)
'5) use 2-dimensional array to save memory space. X[0, ] <-> X[1, ]
ReDim X(0 To 1, 0 To N - 1) As Complex
For i = 0 To N - 1
X(0, i) = xSortedArr(i)
Next i
'6) Do 2's FFT with sorted x
Dim srcIdx As Integer, tgtIdx As Integer
Dim kJump As Long, regionSize As Long
tgtIdx = 0
For curLoop = 0 To totalLoop - 1
tgtIdx = (tgtIdx + 1) Mod 2
srcIdx = (tgtIdx + 1) Mod 2
regionSize = 2 ^ (curLoop + 1) ' if N=8: 2 -> 4 -> 8
kJump = 2 ^ (totalLoop - curLoop - 1) ' if N=8: 4 -> 2 -> 1
i = 0
Do While i < N
Call RegionFFT(X, srcIdx, tgtIdx, i, regionSize, kJump, W)
i = i + regionSize
Loop
Next curLoop
'7)return the value
Dim resultIdx As Integer
If (totalLoop Mod 2) = 0 Then resultIdx = 0 Else resultIdx = 1
Dim result() As Complex
ReDim result(0 To N - 1) As Complex
If isInverse = True Then
For i = 0 To N - 1
result(i) = CDivR(X(resultIdx, i), N)
Next i
Else
For i = 0 To N - 1
result(i) = X(resultIdx, i)
Next i
End If
FFT_Forward = result
Exit Function
ERROR_HANDLE:
Err.Raise Number:=vbObjectError, Description:=("FFT calculation error: " & errMsg)
End Function
Public Sub FFT(xRange As Range, tgtRangeStart As Range, roundDigit As Integer)
Dim X() As Complex
Dim tgtRange As Range
'1. calculate FFT_forward value
On Error GoTo ERROR_HANDLE
X = FFT_Forward(xRange, tgtRangeStart, roundDigit, False)
'2. write to the worksheet
Dim N As Long
N = UBound(X) - LBound(X) + 1
Dim i As Long
Dim arr() As Variant
ReDim arr(0 To N - 1) As Variant
For i = 0 To N - 1
If X(i).im < 0 Then
arr(i) = Round(X(i).re, roundDigit) & Round(X(i).im, roundDigit) & "i"
Else
arr(i) = Round(X(i).re, roundDigit) & "+" & Round(X(i).im, roundDigit) & "i"
End If
Next i
Set tgtRange = Range(Cells(tgtRangeStart.Row, tgtRangeStart.Column), Cells(tgtRangeStart.Row + N - 1, tgtRangeStart.Column))
tgtRange.Rows = Application.Transpose(arr)
Exit Sub
ERROR_HANDLE:
End Sub
Public Sub IFFT(xRange As Range, tgtRangeStart As Range, roundDigit As Integer)
Dim X() As Complex
Dim tgtRange As Range
'1. calculate FFT_forward value
On Error GoTo ERROR_HANDLE
X = FFT_Forward(xRange, tgtRangeStart, roundDigit, True)
'2.write to the worksheet
Dim N As Long
N = UBound(X) - LBound(X) + 1
Dim arr() As Variant
ReDim arr(0 To N - 1) As Variant
Dim i As Long
For i = 0 To N - 1
arr(i) = Round(X(i).re, roundDigit)
Next i
Set tgtRange = Range(Cells(tgtRangeStart.Row, tgtRangeStart.Column), Cells(tgtRangeStart.Row + N - 1, tgtRangeStart.Column))
tgtRange.Rows = Application.Transpose(arr)
Exit Sub
ERROR_HANDLE:
End Sub
Sub LoadFFTForm()
FFT_Form.Show
In alternative to the VBA solution from HeeJin, with LAMBDA functions in recent versions of Excel it is possible to implement the FFT as a pure formula (i.e. without VBA).
One such implementation is https://github.com/altomani/XL-FFT.
For power of two length it uses a recursive radix-2 Cooley-Tukey algorithm
and for other length a version of Bluestein's algorithm that reduces the calculation to a power of two case.
Take a look at the following code. What my problem is is that I can't figure out how to redimension the n integer and the b integer. What I'm doing is the array sent1 is already working and it is populated with about 4 sentences. I need to go through each sentence and work on it but I'm having trouble.
dim sent1()
dim sent2()
dim n as integer, b as integer, x as integer
dim temp_sent as string
b = 0
For n = 1 to ubound(sent1)
temp_sent = sent1(n)
for x = 1 to len(temp_sent1)
code
if a then
b = b + 1
'**THIS IS THE PART OF THE CODE THAT IS NOT WORKING**
redim preserve sent2(1 to ubound(sent1), b)
sent2(n,b) = [code]
next
next
There are two issues in your code:
When you Dim an array without specifying the lower bound it will by default be 0 based (unless you have specified Option Base 1). When explicitly specified, lower bound can be any number, not just 0 or 1
For a multi dimensioned array, Redim Preserve can only change the last dimension, and then only the upper bound.
In general, I find it better to always specify Lower and Upper bounds, eg
Redim MyArray(1 to 10, 0 to 99)
Is there any specific reason why you want to / must use arrays?
If not, I'd suggest using collections instead. You can also have nested collections, e.g.
Dim dimension1 As New Collection
Dim dimension2 AS New Collection
dimension1.Add dimension2
etc.
That way, you won't have to worry about increasing dimensions manually at all. If you need to convert it back to a 2D Array, you can do sth like this in the end
Dim item AS Variant
Dim subCollection AS Collection
Dim nRows AS Integer
Dim nCols AS integer
' assuming "col" is your jagged collection
nRows = col.Count
For Each item in col
If TypeOf item is Collection
Set subCollection = item
If subCollection.Count > nCols Then
nCols = subCollection.Count
End If
Next item
Next item
Dim result(nRows, NCols) As Variant
' Now loop through the collections again and fill the result array
The problem that you have is that you cannot change the rank (dimensions) of an array with a redim statement.
dim sent() creates a 1-rank array, redim sent2(x, y) assumes a 2-rank array. Try dim sent(,).
Also, it will improve performance (and code robustness) if you use
dim sent1() as string
dim sent2(,) as string
In case anyone has this problem here is how I solved it:
<code>
Function find_sentences_complex(instring As String) As Variant
Dim xorr As String: xorr = ChrW(&H22BB)
Dim triple_bar As String: triple_bar = ChrW(&H2261)
Dim idisj As String: idisj = ChrW(&H2228)
Dim cond As String: cond = ChrW(&H2192)
Dim x As Integer, y As Integer, z As Integer, b As Integer
Dim total As Integer, paren_closure As Integer, marker As Boolean
Dim n As Integer
Dim sent1() As Variant, sent3() As Variant
'Dim final1d As Integer, final2d As Integer
Dim b_arr() As Integer
Dim b_max As Integer
Dim temp_string As String
For x = InStr(instring, "(") To Len(instring) Step 1
temp_string = Mid(instring, x, 1)
If Mid(instring, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(instring, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
ReDim Preserve sent1(b)
sent1(b) = Mid(instring, z, (x - z) + 1)
End If
End If
Next
Dim temp_sent1 As String
total = 0
marker = False
b = 0
Dim sent2()
ReDim sent2(UBound(sent1), 5)
For n = 1 To UBound(sent1)
temp_sent1 = sent1(n)
temp_sent1 = Mid(temp_sent1, 2, Len(temp_sent1) - 2)
b = 0
For x = 1 To Len(temp_sent1)
temp_string = Mid(instring, x, 1)
If Mid(temp_sent1, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(temp_sent1, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
'ReDim Preserve sent2(n, b)
sent2(n, b) = Mid(temp_sent1, z, (x - z) + 1)
End If
End If
Next
'this part of the code redimensions the side of the array
ReDim Preserve b_arr(n)
b_arr(n) = b
Next
b_max = MaxValOfIntArray(b_arr)
ReDim Preserve sent2(UBound(sent1), b_max)
End Function
Public Function MaxValOfIntArray(ByRef TheArray As Variant) As Integer
'This function gives max value of int array without sorting an array
Dim i As Integer
Dim MaxIntegersIndex As Integer
MaxIntegersIndex = 0
For i = 1 To UBound(TheArray)
If TheArray(i) > TheArray(MaxIntegersIndex) Then
MaxIntegersIndex = i
End If
Next
'index of max value is MaxValOfIntArray
MaxValOfIntArray = TheArray(MaxIntegersIndex)
End Function
</code>
Take a look at the following code. What my problem is is that I can't figure out how to redimension the n integer and the b integer. What I'm doing is the array sent1 is already working and it is populated with about 4 sentences. I need to go through each sentence and work on it but I'm having trouble.
dim sent1()
dim sent2()
dim n as integer, b as integer, x as integer
dim temp_sent as string
b = 0
For n = 1 to ubound(sent1)
temp_sent = sent1(n)
for x = 1 to len(temp_sent1)
code
if a then
b = b + 1
'**THIS IS THE PART OF THE CODE THAT IS NOT WORKING**
redim preserve sent2(1 to ubound(sent1), b)
sent2(n,b) = [code]
next
next
There are two issues in your code:
When you Dim an array without specifying the lower bound it will by default be 0 based (unless you have specified Option Base 1). When explicitly specified, lower bound can be any number, not just 0 or 1
For a multi dimensioned array, Redim Preserve can only change the last dimension, and then only the upper bound.
In general, I find it better to always specify Lower and Upper bounds, eg
Redim MyArray(1 to 10, 0 to 99)
Is there any specific reason why you want to / must use arrays?
If not, I'd suggest using collections instead. You can also have nested collections, e.g.
Dim dimension1 As New Collection
Dim dimension2 AS New Collection
dimension1.Add dimension2
etc.
That way, you won't have to worry about increasing dimensions manually at all. If you need to convert it back to a 2D Array, you can do sth like this in the end
Dim item AS Variant
Dim subCollection AS Collection
Dim nRows AS Integer
Dim nCols AS integer
' assuming "col" is your jagged collection
nRows = col.Count
For Each item in col
If TypeOf item is Collection
Set subCollection = item
If subCollection.Count > nCols Then
nCols = subCollection.Count
End If
Next item
Next item
Dim result(nRows, NCols) As Variant
' Now loop through the collections again and fill the result array
The problem that you have is that you cannot change the rank (dimensions) of an array with a redim statement.
dim sent() creates a 1-rank array, redim sent2(x, y) assumes a 2-rank array. Try dim sent(,).
Also, it will improve performance (and code robustness) if you use
dim sent1() as string
dim sent2(,) as string
In case anyone has this problem here is how I solved it:
<code>
Function find_sentences_complex(instring As String) As Variant
Dim xorr As String: xorr = ChrW(&H22BB)
Dim triple_bar As String: triple_bar = ChrW(&H2261)
Dim idisj As String: idisj = ChrW(&H2228)
Dim cond As String: cond = ChrW(&H2192)
Dim x As Integer, y As Integer, z As Integer, b As Integer
Dim total As Integer, paren_closure As Integer, marker As Boolean
Dim n As Integer
Dim sent1() As Variant, sent3() As Variant
'Dim final1d As Integer, final2d As Integer
Dim b_arr() As Integer
Dim b_max As Integer
Dim temp_string As String
For x = InStr(instring, "(") To Len(instring) Step 1
temp_string = Mid(instring, x, 1)
If Mid(instring, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(instring, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
ReDim Preserve sent1(b)
sent1(b) = Mid(instring, z, (x - z) + 1)
End If
End If
Next
Dim temp_sent1 As String
total = 0
marker = False
b = 0
Dim sent2()
ReDim sent2(UBound(sent1), 5)
For n = 1 To UBound(sent1)
temp_sent1 = sent1(n)
temp_sent1 = Mid(temp_sent1, 2, Len(temp_sent1) - 2)
b = 0
For x = 1 To Len(temp_sent1)
temp_string = Mid(instring, x, 1)
If Mid(temp_sent1, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(temp_sent1, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
'ReDim Preserve sent2(n, b)
sent2(n, b) = Mid(temp_sent1, z, (x - z) + 1)
End If
End If
Next
'this part of the code redimensions the side of the array
ReDim Preserve b_arr(n)
b_arr(n) = b
Next
b_max = MaxValOfIntArray(b_arr)
ReDim Preserve sent2(UBound(sent1), b_max)
End Function
Public Function MaxValOfIntArray(ByRef TheArray As Variant) As Integer
'This function gives max value of int array without sorting an array
Dim i As Integer
Dim MaxIntegersIndex As Integer
MaxIntegersIndex = 0
For i = 1 To UBound(TheArray)
If TheArray(i) > TheArray(MaxIntegersIndex) Then
MaxIntegersIndex = i
End If
Next
'index of max value is MaxValOfIntArray
MaxValOfIntArray = TheArray(MaxIntegersIndex)
End Function
</code>