Moving average in VBA

artz

Well-known Member
Joined
Aug 11, 2002
Messages
830
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I am trying to modify some moving average calculation code found on the Web to meet my requirements. The original code used a combobox where the moving average length, input range, and output ranges were placed. For my purposes, I need more flexibility instead working with variable ranges in a workbook.

Below are two versions of the code. The first is the original, the latter, what I've attempted to modify.
Original code:
Code:
Private Sub buttonSubmit_Click()
Dim inputRange, outputRange As Range
Dim inputPeriod As Integer
Dim inputAddress, outputAddress As String

If comboTypeMA.Value <> "Exponential" _
    And comboTypeMA.Value <> "Simple" _
    And comboTypeMA.Value <> "Weighted" = True Then
        MsgBox "Please select a moving average type from the list."
        RefInputRange.SetFocus
        Exit Sub
ElseIf RefInputRange.Value = "" Then
        MsgBox "Please select the input range."
        RefInputRange.SetFocus
        Exit Sub
ElseIf RefOutputRange.Value = "" Then
        MsgBox "Please select the output range."
        RefOutputRange.SetFocus
        Exit Sub
ElseIf RefInputPeriod.Value = "" Then
        MsgBox "Please select the moving average period."
        RefInputPeriod.SetFocus
        Exit Sub
ElseIf Not IsNumeric(RefInputPeriod.Value) Then
        MsgBox "Moving average period must be a number."
        RefInputPeriod.SetFocus
        Exit Sub
End If

inputAddress = RefInputRange.Value
Set inputRange = Range(inputAddress)
outputAddress = RefOutputRange.Value
Set outputRange = Range(outputAddress)
inputPeriod = RefInputPeriod.Value

If inputRange.Columns.Count <> 1 Then
        MsgBox "Input range can have only one column."
        RefInputRange.SetFocus
        Exit Sub
ElseIf inputRange.Rows.Count <> outputRange.Rows.Count Then
        MsgBox "Output range has a different number of rows than the input range."
        RefInputRange.SetFocus
        Exit Sub
           End If
                  
Dim RowCount As Integer
RowCount = inputRange.Rows.Count
Dim cRow As Integer
ReDim inputarray(1 To RowCount)
For cRow = 1 To RowCount
inputarray(cRow) = inputRange.Cells(cRow, 1).Value
Next cRow

If inputPeriod > RowCount Then
MsgBox "Number of selected observations is " & RowCount & " and the period is " & _
inputPeriod & ". The input range must have a higher or equal amount of elements than the selected period."
RefInputRange.SetFocus
Exit Sub
End If

If inputPeriod <= 0 Then
MsgBox "Moving average period must be higher than 0."
RefInputPeriod.SetFocus
Exit Sub
End If


ReDim outputarray(inputPeriod To RowCount) As Variant

'SMA-----------------------------------------

If comboTypeMA.Value = "Simple" Then
Dim i, j As Integer
Dim temp As Double

For i = inputPeriod To RowCount
temp = 0
For j = (i - (inputPeriod - 1)) To i
temp = temp + inputarray(j)

Next j
outputarray(i) = temp / inputPeriod
outputRange.Cells(i, 1).Value = outputarray(i)
Next i

outputRange.Cells(0, 1).Value = "SMA(" & inputPeriod & ")"


'EMA------------------------------------------

ElseIf comboTypeMA.Value = "Exponential" Then

Dim alpha As Double

alpha = 2 / (inputPeriod + 1)

For j = 1 To inputPeriod
temp = temp + inputarray(j)
Next j

outputarray(inputPeriod) = temp / inputPeriod

For i = inputPeriod + 1 To RowCount
outputarray(i) = outputarray(i - 1) + alpha * (inputarray(i) - outputarray(i - 1))
Next i

For i = inputPeriod To RowCount
outputRange.Cells(i, 1).Value = outputarray(i)
Next i

outputRange.Cells(0, 1).Value = "EMA(" & inputPeriod & ")"

'WMA------------------------------------------

ElseIf comboTypeMA.Value = "Weighted" Then
Dim temp2 As Integer
For i = inputPeriod To RowCount
temp = 0
temp2 = 0

For j = (i - (inputPeriod - 1)) To i
temp = temp + inputarray(j) * (j - i + inputPeriod)
temp2 = temp2 + (j - i + inputPeriod)
Next j

outputarray(i) = temp / temp2
outputRange.Cells(i, 1).Value = outputarray(i)
Next i

outputRange.Cells(0, 1).Value = "WMA(" & inputPeriod & ")"

End If


Unload MA_Form

End Sub



My code:
Code:
Sub MovingAvg()

Dim RowCount As Integer
'RowCount = inputRange.Rows.Count
RowCount = Worksheets("Data").Cells(Rows.Count, "K2").End(xlUp).Count

Dim cRow As Integer
ReDim inputarray(1 To RowCount)
For cRow = 1 To RowCount
inputarray(cRow) = inputRange.Cells(cRow, 1).Value
Next cRow

inputperiod = CInt(Sheets("Chart").Range("E2").Value)

TypeMa = Sheets("Chart").Range("F2").Value


'SMA-----------------------------------------
If TypeMa = "SMA" Then
Dim i, j As Integer
Dim temp As Double
For i = inputPeriod To RowCount
temp = 0
For j = (i - (inputPeriod - 1)) To i
temp = temp + inputarray(j)
Next j
outputarray(i) = temp / inputPeriod
outputRange.Cells(i, 1).Value = outputarray(i)
Next i
outputRange.Cells(0, 1).Value = "SMA(" & inputPeriod & ")"

'EMA------------------------------------------
ElseIf TypeMa = "Ema" Then
Dim alpha As Double
alpha = 2 / (inputPeriod + 1)
For j = 1 To inputPeriod
temp = temp + inputarray(j)
Next j
outputarray(inputPeriod) = temp / inputPeriod
'First the value of alpha is determined. Because in the computation, the value 'of the EMA is 

based on the previous EMA, the first one will be the simple 'moving average.
For i = inputPeriod + 1 To RowCount
outputarray(i) = outputarray(i - 1) + alpha * (inputarray(i) - outputarray(i - 1))
Next i
'Starting with the second moving average, they will be computed based on the 'above formula: 

the previous EMA plus alpha multiplied by the difference 'between the current number from the 

inputarray and the previous EMA value.
For i = inputPeriod To RowCount
outputRange.Cells(i, 1).Value = outputarray(i)
Next i
outputRange.Cells(0, 1).Value = "EMA(" & inputPeriod & ")"

'WMA------------------------------------------
ElseIf TypeMA = "Wma" Then
Dim temp2 As Integer
For i = inputPeriod To RowCount
temp = 0
temp2 = 0
For j = (i - (inputPeriod - 1)) To i
temp = temp + inputarray(j) * (j - i + inputPeriod)
temp2 = temp2 + (j - i + inputPeriod)
Next j
outputarray(i) = temp / temp2
outputRange.Cells(i, 1).Value = outputarray(i)
Next i
outputRange.Cells(0, 1).Value = "WMA(" & inputPeriod & ")"
End If

End Sub

Data are in column K on the Data worksheet, beginning at row K2. Example data is shown below.

The desired output range would begin at cell S2, S1 is the header.

Right now, I get an error at:
Code:
ReDim inputarray(1 To RowCount)

Some example data is shown below.

Example data:
Data
52.03
52.08
52.44
52.59
54.37
54.85
53.79
53.59
55.03
55.09
54.64
54.73
55.04
54.51
56.48
54.76
56.05
56.37
57.77
58.01
57.8
58.12
57.13
56.47
56.58
57.35
56.57
55.85
57.15
56.64

The error says "expected array". This is confusing because the original code works and the inputarray is not defined previous to this in that code. I don't understand.

Is anybody able to get this code working?

Thanks,

Art
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
It looks like there will be a few problems with your code.

For starters, this isn't a valid reference:

RowCount = Worksheets("Data").Cells(Rows.Count, "K2").End(xlUp).Count

Later on, you start referring to outputarray(i) when you haven't defined this as an array.

Also, rather than reading cell by cell into inputarray, and writing cell by cell from outputarray to outputRange, you can write range <---> array and vice versa in a single line.

I'm happy to help further with your code, but curious why you don't just use an Excel formula approach, e.g. for SMA, something like:

Code:
lInputPeriod = 3  'say
Range("S" & lInputPeriod + 1 & ":S" & Range("K" & Rows.Count).End(xlUp).Row).Formula = "=AVERAGE(K2:K" & lInputPeriod + 1 & ")"
 
Upvote 0
Hi Stephen,

Thanks for your response. The reason for not simply doing this with cell formulas is that I like the idea of a VBA module that I can port to different workbooks that easily provides the choice of 3 types of moving averages.

As I implied, this is not my code, I am just trying to modify the input/output structure so that I don't need the userform.

The original code does in fact work as written. So I am also not understanding how these arrays are setup.

Can you see how to restructure the code so that it eliminates these arrays? I don't know how to do that.

Thanks,

Art
 
Upvote 0
You could make a formula approach completely portable - you just need to put the formula in the right place (some output range) and point them to the data (some input range).

If you're happy with just numerical output, perhaps a function approach? Put your data in Sheet1!A1:A10, say, and in your chosen output range anywhere else in the workbook:

{= SMA(Sheet1!A1:A10)} array-entered.

Not sure if you want central average? It appears the current code doesn't do this.

Code:
'No error checking!
Function SMA(rngInput As Range, lPeriod As Long) As Double()

    Dim vInput As Variant
    Dim dTemp() As Double
    Dim lRows As Long, i As Long
    
    vInput = rngInput.Value
    lRows = Application.Caller.Rows.Count
    ReDim dTemp(1 To lRows, 1 To 1)
    
    For i = 1 To lPeriod
        dTemp(lPeriod, 1) = dTemp(lPeriod, 1) + vInput(i, 1)
    Next i
    dTemp(lPeriod, 1) = dTemp(lPeriod, 1) / lPeriod
    
    For i = lPeriod + 1 To lRows
        dTemp(i, 1) = dTemp(i - 1, 1) + (vInput(i, 1) - vInput(i - lPeriod, 1)) / lPeriod
    Next i
    
    SMA = dTemp

End Function

You could write similar functions for EMA and WMA, or include in one function with extra parameters.
 
Upvote 0
Hi Stephen,

Thanks for your response and code. In my collection of code, I have some similar code that uses an array. Arrays are difficult to use and also this code does not allow for a dynamic data range. I have some code for a sub that purportedly computes the SMA. I haven't tried it. What I don't like about this code, is that it is written with RC notation. I can never figure out how to modify macros with RC. The code that I have is:
Code:
Sub MovingAverage()

Dim i As Long
Dim J As Long
Dim Days As Integer
Dim LastRow As Long
Dim MyArray() As String

Days = 21
LastRow = Range("F" & Rows.Count).End(xlUp).Row - Days + 1

ReDim MyArray(12 To LastRow)
For i = 12 To LastRow
    MyArray(i) = "=AVERAGE(RC[-1]:R[" & Days - 1 & "]C[-1])"
Next i

For J = 12 To LastRow
    Range("G" & J) :-).FormulaR1C1 = MyArray(J)
Next J

End Sub

So, if you are willing, I'd suggest that first the code viability is confirmed. If not, maybe an easy fix. Then maybe redo without the RC notation. We can worry about the EMA and WMA later. How does that sound?

Thanks,

Art
 
Upvote 0
This uses an Excel formula approach, i.e. similar to my more succinct Post #2.

Don't get hung up on whether the approach uses arrays or not. The questions are:

- Do you want the smoothed values as Excel formulae, or values only?

- For a moving average, we need to know InputRange, OutputRange and other parameters such as AveragePeriod (SMA) and Alpha (EMA), all of which can be made dynamic. How do you want to obtain these values, e.g. from cells, from Input boxes, or as arguments passed to a sub or function?
 
Upvote 0
Hi Stephen,


Interesting we must be a parallel universe; I was thinking the some of the same things after my last post.

If I were king, the VBA calculation for all 3 moving averages would have the following attributes:

1) Sub not UDF
2) Arrays OK if done in VBA; no cell array formulas
3) Use a range in the VBA code such as: Range.K2 to last used row in column K to specify input; this is easy to change in VBA code when needed
5) Smoothing period specified from cell value
6) Output range specified as Range.xxxx; this will vary based on the smoothing period. Column will remain constant. Take into account header row
7) Output should start at the correct row based on the smoothing period. Data with 14 smoothing periods would not output to the first non-header row of the output column; requires offset based on smoothing period. Makes sense?

That's all. Seems like this should be relatively non-problematic.

I hope this makes sense and is reasonable.

Generally, I work in a world of requirements for my occupation, however, I did not want to sound imposing. It seems instead, I sounded ambiguous.

Hopefully, the requirements above will help you understand what I am trying to achieve for this code.

Many Thanks,

Art
 
Upvote 0
Stephen,

Forgot an important input: type of moving average. This can be as simple as using a cell value of 1= SMA, 2 = EMA, 3= WMA. It's easy to put an explanation in the cells as to what this is.

Art
 
Upvote 0
Here's some quick code to get you started. You can determine the parameters any way you like, e.g. cell values, and then call the generic Sub.

I have assumed that for EMA, you want to pass alpha as a parameter, whereas your code has: alpha = 2 / (inputPeriod + 1). You code also calculates the first smoothed value based on an arithmetic average. I don't know if these are your requirements, or just what you happened to find on the internet?

For WMA (which I haven't yet coded), your code applies weights based on the triangular numbers, e.g. for an averaging period of 5, weights of 5/15 for the current observation, 4/15 for the previous observation, 3/15 ... 1/16 for the 4th previous. Again, is that what you wanted, or just what you happened to find?

Code:
Enum AverageType
SMA = 1
EMA = 2
WMA = 3
End Enum
Sub GetMovingAverages(rngInputColumn As Range, rngOutputCell As Range, _
    Optional lType As Long = SMA, Optional lPeriod As Long = 3, Optional dAlpha As Double)

    Dim vInput As Variant
    Dim dOutput() As Double
    Dim lRows As Long, i As Long
    
    vInput = rngInputColumn.Value
    lRows = UBound(vInput)
    ReDim dOutput(1 To lRows, 1 To 1)
    
    Select Case lType
    Case SMA
        For i = 1 To lPeriod
            dOutput(lPeriod, 1) = dOutput(lPeriod, 1) + vInput(i, 1)
        Next i
        dOutput(lPeriod, 1) = dOutput(lPeriod, 1) / lPeriod
        For i = lPeriod + 1 To lRows
            dOutput(i, 1) = dOutput(i - 1, 1) + (vInput(i, 1) - vInput(i - lPeriod, 1)) / lPeriod
        Next i
    
    Case EMA
        dOutput(1, 1) = vInput(1, 1)
        For i = 2 To lRows
            dOutput(i, 1) = dAlpha * vInput(i, 1) + (1 - dAlpha) * dOutput(i - 1, 1)
        Next i
    
    Case WMA
        '???
    
    End Select
    
    rngOutputCell.Resize(lRows).Value = dOutput
    
End Sub
 
Upvote 0
Hi Stephen,

Very much appreciate this code, thanks. I will try it as soon as I can. For your questions on the period for the EMA; that is the standard way to calculate what is usually called alpha. For the WMA, again, again the weighting scheme is standard.

I will put the input for the MA type in:
Code:
Sheets("Chart").Range("D2").Value
and the period in:
Code:
Sheets("Chart").Range("D2").Value

A couple of questions:

Can we define the input range with something like:
Code:
Set MyRange = Worksheets("Data").Range("K2:K" & LastRow)
where LastRow is defined as:
Code:
LastRow = Worksheets("Data").Cells(Rows.Count, "E").End(xlUp).Row

The next question is how defining the output column. There must be a way similar to the MyRange above. Do you know how we could do that?

Again, thanks. We'll get there. :) -Art
 
Upvote 0

Forum statistics

Threads
1,214,583
Messages
6,120,383
Members
448,956
Latest member
JPav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top