Moving average in VBA

artz · Jun 2, 2015

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

artz · Jun 5, 2015

Hi Stephen,

I took a swing at integrating my comments in my last post. In debug mode, the code below runs until the last code line, then produces an error. Can you take a look at what I added and see if you can make it work with those changes. Also, can we make a similar method to select the output column and row?

Code:

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
    Dim LastRow As Long
    
    LastRow = Worksheets("Chart").Cells(Rows.Count, "K").End(xlUp).Row
    lType = Sheets("Chart").Range("D2").Value
    lPeriod = Sheets("Chart").Range("E2").Value
    'vInput = rngInputColumn.Value
    vInput = Worksheets("Data").Range("K2:K" & LastRow)
    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

Thanks,

Art

StephenCrump · Jun 5, 2015

If I'm reading your initial code correctly, it looks like you want results like this:

Excel 2010

	A	B	C	D
1	Data	SMA3	EMA4	WMA5
2	1
3	3
4	2	2.00
5	4.5	3.17	2.63
6	6	4.17	3.98	4.07
7	2	4.17	3.19	3.63
8	3	3.67	3.11	3.47
9	5	3.33	3.87	3.97
10	7.5	5.17	5.32	5.10
11	10	7.50	7.19	6.87

Sheet1

I'd recommend that once you're happy with the calculation methodology, you keep Sub GetMovingAverages as a generic utility. When you call the Sub, you can determine the parameters any way you like:

Code:

Enum AverageType
SMA = 1
EMA = 2
WMA = 3
End Enum
Sub TestNo1()

    Dim rngData As Range
    Dim lLastRow As Long

    lLastRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = Range("Sheet1!A2:A" & lLastRow)
    
    Call GetMovingAverages(rngData, Range("Sheet1!B2"))
    Call GetMovingAverages(rngData, Range("Sheet1!C2"), 4, EMA)
    Call GetMovingAverages(rngData, Range("Sheet1!D2"), 5, WMA)
        
End Sub
Sub GetMovingAverages(rngInputColumn As Range, rngOutputCell As Range, _
    Optional lPeriod As Long = 3, Optional lType As Long = SMA)

    Dim vInput As Variant, vOutput() As Variant
    Dim dAlpha As Double, dTemp1 As Double, dTemp2 As Double
    Dim lRows As Long, lDenominator As Long, i As Long
    
    vInput = rngInputColumn.Value
    lRows = UBound(vInput)
    ReDim vOutput(1 To lRows, 1 To 1)
    dAlpha = 2 / (lPeriod + 1)
    For i = 1 To lPeriod
        dTemp1 = dTemp1 + vInput(i, 1)
        dTemp2 = dTemp2 + vInput(i, 1) * i
    Next i
        
    Select Case lType
    Case SMA
        vOutput(lPeriod, 1) = dTemp1 / lPeriod
        For i = lPeriod + 1 To lRows
            vOutput(i, 1) = vOutput(i - 1, 1) + (vInput(i, 1) - vInput(i - lPeriod, 1)) / lPeriod
        Next i
    
    Case EMA
        vOutput(lPeriod, 1) = dTemp1 / lPeriod
        For i = lPeriod + 1 To lRows
            vOutput(i, 1) = dAlpha * vInput(i, 1) + (1 - dAlpha) * vOutput(i - 1, 1)
        Next i
    
    Case WMA
        lDenominator = lPeriod * (lPeriod + 1) / 2
        vOutput(lPeriod, 1) = dTemp2 / lDenominator
        For i = lPeriod + 1 To lRows
            dTemp2 = dTemp2 - dTemp1 + lPeriod * vInput(i, 1)
            dTemp1 = dTemp1 + vInput(i, 1) - vInput(i - lPeriod, 1)
            vOutput(i, 1) = dTemp2 / lDenominator
        Next i
    End Select
    
    rngOutputCell.Resize(lRows).Value = vOutput
    
End Sub

artz · Jun 5, 2015

Hi Stephen,

Great reply, thanks. I still need to try this out, but on first blush, looks exactly right. Quick question is: can the two subs be combined easily? Seems they could be. When we finish with the final version of this code, it will be applicable in many fields of study. Currently, based on much searching, there are no viable moving average VBA subs (all UDF's) on the Internet. I've checked; ad nauseam.

My application in this case is medical research, but I can see the need in many engineering disciplines and also in market trading applications.

I'll check out your latest code and let you know.

Thanks for your collaboration.

Best Regards,

Art

StephenCrump · Jun 6, 2015

You can combine code if you want to. But the nice thing about having a generic Sub is that whilst it expects a range as the first argument, for example, it doesn't care how you have determined that range. In different applications, you may want to choose the range based on Selection, dynamic range, InputBox etc etc, but you can still use the same Sub.

The downside of the Sub approach with values is that it is not dynamic, like a UDF. Change the values in rngInputColumn, and the moving averages will not update. This could be dangerous!

Possibilities:

1. Trigger the Sub from Worksheet_Change, i.e.

Code:

If Not Intersect(Target, rngInputColumn) Is Nothing _
    Then Call GetMovingAverages( ....)

2. The Sub could apply a UDF to the correct range, or

3. We could use an Excel formula approach, perhaps like this:

Code:

Sub GetMovingAveragesFormulae(rngInputColumn As Range, rngOutputCell As Range, _
    Optional lPeriod As Long = 3, Optional lType As Long = SMA)

    Dim rngOutput As Range
    Dim dAlpha As Double
    Dim lRows As Long, lDenominator As Long, i As Long
    Dim sSheetName As String, sFormula As String
    
    lRows = rngInputColumn.Rows.Count
    Set rngOutput = rngOutputCell.Offset(lPeriod - 1).Resize(lRows + 1 - lPeriod)
    If rngInputColumn.Parent.Name <> rngOutputCell.Parent.Name _
        Then sSheetName = "'" & rngInputColumn.Parent.Name & "'!"
    
    Select Case lType
    Case SMA
        rngOutput.Formula = "=AVERAGE(" & sSheetName & rngInputColumn(1).Address(RowAbsolute:=False) & ":" _
            & rngInputColumn(lPeriod).Address(RowAbsolute:=False) & ")"
    Case EMA
        dAlpha = 2 / (lPeriod + 1)
        rngOutput.Formula = "=" & dAlpha & "*" & sSheetName & rngInputColumn(lPeriod).Address(RowAbsolute:=False) & "+" & 1 - dAlpha & "*" & rngOutput(0).Address(RowAbsolute:=False)
        rngOutput(1).Formula = "=AVERAGE(" & sSheetName & rngInputColumn(1).Address(RowAbsolute:=False) & ":" _
            & rngInputColumn(lPeriod).Address(RowAbsolute:=False) & ")"
    
    Case WMA
        lDenominator = lPeriod * (lPeriod + 1) / 2
        For i = 1 To lPeriod
            sFormula = sFormula & "+" & i & "*" & sSheetName & rngInputColumn(i).Address(RowAbsolute:=False)
        Next i
        rngOutput.Formula = "=(" & sFormula & ")/" & lDenominator
    End Select
    
End Sub

artz · Jun 6, 2015

Hi Stephen,

You are right, unless the sub is called, it is not dynamic. In my case, I perform a Webquery, create a chart and when the chart macro finishes, I'll call the MovingAvg sub. But, point well taken.

Best Regards,

Art

artz · Jun 8, 2015

Hi Stephen,

I have one more issue that I can't fix. I wanted the MA period and type of MA selectable from cells. It was not a problem for the period value shown in the code below, however the text value causes a problem. I tried instead of

Code:

.Value

I tried

Code:

 .Text

Also formatted the cell as text and still receive a type mismatch error. Below is the code that I tried:

Code:

Sub TestNo1()

    Dim rngData As Range
    Dim lLastRow As Long

    lLastRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = Range("Sheet1!A2:A" & lLastRow)
    
    Call GetMovingAverages(rngData, Range("Sheet1!B2"), Sheets("Sheet1").Range("G2").Value, Sheets("Sheet1").Range("F2").Value)
    Call GetMovingAverages(rngData, Range("Sheet1!C2"), Sheets("Sheet1").Range("I2").Value, EMA)
    Call GetMovingAverages(rngData, Range("Sheet1!D2"), Sheets("Sheet1").Range("K2").Value, WMA)
        
End Sub

Do you know how to change your code to read the text value?

Thanks,

Art

StephenCrump · Jun 8, 2015

Based on your Post #8, I've set up the code to expect values of 1, 2 or 3 for the average type.

Code:

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

So if you try passing "SMA", say, you'll get a type mismatch error.

If you do want to pass "SMA", "EMA" or "WMA" you'll need to change the last argument, e.g. Optional sType As String = "SMA", and modify the Select Case to handle text values.

artz · Jun 8, 2015

Hi Stephen,

Thanks for your comments. I just moments ago created 3 optionbuttons that I labeled SMA, EMA, and WMA. The output is either a 1,2, or a 3. So, works fine. I am puzzled though, with this code line:

Code:

Call GetMovingAverages(rngData, Range("Sheet1!C2"), Sheets("Sheet1").Range("I2").Value, EMA)

The EMA input is text in that line of code. Why does that work and reading EMA from a cell does not?

Thanks,

Art

StephenCrump · Jun 8, 2015

Sorry, I don't follow what you're doing.

When this next line of code doesn't work, what is EMA, and how is it being set?

Code:

Call GetMovingAverages(rngData, Range("Sheet1!C2"), Sheets("Sheet1").Range("I2").Value, EMA)

artz · Jun 8, 2015

Hi Stephen,

So, works:

Code:

Call GetMovingAverages(rngData, Range("Sheet1!B2"), Sheets("Sheet1").Range("G2").Value, Sheets("Sheet1").SMA)

Doesn't work:

Code:

Call GetMovingAverages(rngData, Range("Sheet1!B2"), Sheets("Sheet1").Range("G2").Value, Sheets("Sheet1").Range("F2").Value)

Both reference SMA. Value in cell F2 is SMA. Why does the first work, but latter does not. Can you explain?

Thanks,

Art

Moving average in VBA

artz

Well-known Member

artz

Well-known Member

Excel Facts

StephenCrump

MrExcel MVP

artz

Well-known Member

StephenCrump

MrExcel MVP

artz

Well-known Member

artz

Well-known Member

StephenCrump

MrExcel MVP

artz

Well-known Member

StephenCrump

MrExcel MVP

artz

Well-known Member

Similar threads

Forum statistics

Share this page

Moving average in VBA

Well-known Member

Well-known Member

Excel Facts

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock