Correct VBA code to output on correct row

A

artz

Well-known Member
Joined
Aug 11, 2002
Messages
830
Office Version
  1. 2016
Platform
  1. Windows
Hi,
I cobbled together some code that I want to use to create a Weighted Moving Average or WMA. The code is producing the correct numerical values however, the code is not producing the output on the correct row.

For instance when n, the period equals n=7, the output should at n+1. There can't be an output until the first n input data points are processed. As I said earlier, the calculation is correct, matching a similar calculation exactly, but offset by one row. The code below, for an n=7 should have 7 blanks starting at row 2 (for n=7) before the calculated data are output.
Code: 
Sub wma_11()

Dim i As Long
Dim n As Long
Dim wma As Double
Dim weight As Double
Dim sumWeight As Double
Dim colData As Long
Dim colWMA As Long

colData = 2 ' Column containing the data
colWMA = 6 ' Column to output the WMA
n = 7 ' Length of the WMA

For i = 2 To Cells(Rows.Count, colData).End(xlUp).Row
If i < n + 1 Then
Cells(i, colWMA).Value = ""
Else
wma = 0
weight = n
sumWeight = (n * (n + 1)) / 2
For j = i - n + 1 To i
wma = wma + Cells(j, colData).Value * weight
weight = weight - 1
Next j
Cells(i, colWMA).Value = wma / sumWeight
End If
Next i

End Sub

Notice that the sub name is WMA_11, that's how many code iterations I've been through without getting this issue resolved.

Is there a kind soul in the Forum who can find my error in this code correct when the data output begins?

Any help is greatly appreciated.

Thanks,

Art
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
How is your data set up?
Can show us the worksheet or a screenshot?
 
Upvote 0
Hi Larry,

These two things may help you. There is a view of the work sheet and sample data below for testing. Please let me know if you have further questions.

Thanks,

Art


DateData
10/24/58​
540.72​
10/27/58​
539.52​
11/3/58​
543.22​
11/10/58​
554.26​
11/17/58​
564.68​
11/24/58​
554.88​
12/1/58​
557.46​
12/8/58​
556.75​
12/15/58​
562.27​
12/22/58​
573.17​
12/29/58​
572.73​
1/5/59​
587.59​
1/12/59​
592.72​
1/19/59​
595.75​
1/26/59​
596.07​
2/2/59​
593.96​
2/9/59​
581.36​
2/16/59​
587.97​
2/24/59​
602.21​
 

Attachments

  • WMA_output.jpg
    WMA_output.jpg
    122.2 KB · Views: 8
Upvote 0
See if this works for you.

Rich (BB code): 
Sub wma_11()

    Dim i As Long, j As Long
    Dim n As Long
    Dim wma As Double
    Dim weight As Double
    Dim sumWeight As Double
    Dim colData As Long
    Dim colWMA As Long
    Dim rowFirst As Long
    
    colData = 2 ' Column containing the data
    colWMA = 6 ' Column to output the WMA
    n = 7 ' Length of the WMA
    rowFirst = 2
    
    For i = rowFirst To Cells(Rows.Count, colData).End(xlUp).Row
        If i < n + 1 Then
            Cells(i, colWMA).Value = ""
        Else
            wma = 0
            weight = n
            sumWeight = (n * (n + 1)) / 2
            For j = i - n + 1 To i
                wma = wma + Cells(j, colData).Value * weight
                weight = weight - 1
            Next j
            If (i - rowFirst + 1) >= n Then
                Cells(i, colWMA).Value = wma / sumWeight
            End If
        End If
    Next i

End Sub
 
Upvote 0
Alex Blakenburg said:
See if this works for you.

Rich (BB code): 
Sub wma_11()

    Dim i As Long, j As Long
    Dim n As Long
    Dim wma As Double
    Dim weight As Double
    Dim sumWeight As Double
    Dim colData As Long
    Dim colWMA As Long
    Dim rowFirst As Long
  
    colData = 2 ' Column containing the data
    colWMA = 6 ' Column to output the WMA
    n = 7 ' Length of the WMA
    rowFirst = 2
  
    For i = rowFirst To Cells(Rows.Count, colData).End(xlUp).Row
        If i < n + 1 Then
            Cells(i, colWMA).Value = ""
        Else
            wma = 0
            weight = n
            sumWeight = (n * (n + 1)) / 2
            For j = i - n + 1 To i
                wma = wma + Cells(j, colData).Value * weight
                weight = weight - 1
            Next j
            If (i - rowFirst + 1) >= n Then
                Cells(i, colWMA).Value = wma / sumWeight
            End If
        End If
    Next i

End Sub
Click to expand...

Alex Blakenburg said:
See if this works for you.

Rich (BB code): 
Sub wma_11()

    Dim i As Long, j As Long
    Dim n As Long
    Dim wma As Double
    Dim weight As Double
    Dim sumWeight As Double
    Dim colData As Long
    Dim colWMA As Long
    Dim rowFirst As Long
   
    colData = 2 ' Column containing the data
    colWMA = 6 ' Column to output the WMA
    n = 7 ' Length of the WMA
    rowFirst = 2
   
    For i = rowFirst To Cells(Rows.Count, colData).End(xlUp).Row
        If i < n + 1 Then
            Cells(i, colWMA).Value = ""
        Else
            wma = 0
            weight = n
            sumWeight = (n * (n + 1)) / 2
            For j = i - n + 1 To i
                wma = wma + Cells(j, colData).Value * weight
                weight = weight - 1
            Next j
            If (i - rowFirst + 1) >= n Then
                Cells(i, colWMA).Value = wma / sumWeight
            End If
        End If
    Next i

End Sub
Click to expand...
Hi Alex;
Thanks for your response. The numerical calculation is correct, however the number of blank cell in the output column. The attached screen cap shows that. This was maddening for me to figure out. Either I got what you got, one blank row short or the calculation values were incorrect. If you have some more ideas, please give them a try.
Thanks,
Art
 

Attachments

  • WMA_output2.jpg
    WMA_output2.jpg
    160.5 KB · Views: 8
Upvote 0
Alex. sorry about my poor English. I went to Preview view and realized a sentence wasn't complete but couldn't go back to edit it but I think you get the gist of what I was saying. -Art
 
Upvote 0
If you just want the same figures to be just 1 row lower just "+ 1" to the output line in my code.
Rich (BB code): 
                Cells(i + 1, colWMA).Value = wma / sumWeight
This does mean that your last value will be 1 past the end of the data rows though, is that what you are expecting ?
 
Upvote 0
Alex Blakenburg said:
If you just want the same figures to be just 1 row lower just "+ 1" to the output line in my code.
Rich (BB code): 
                Cells(i + 1, colWMA).Value = wma / sumWeight
This does mean that your last value will be 1 past the end of the data rows though, is that what you are expecting ?
Click to expand...
Hi Alex, yah it seems that way but not true. Attached shows the alternative calculation in Column E (actual calculation) compared to the output from the last code you posted in Column F. The alternative calculation takes care of the number of blank cells correctly and also finishes at the correct data row. I prefer the code I posted to the Forum since the code in the alternative calculation is too complicated. If it helps I can post that code which sets up input and output arrays but I prefer the simplest code possible to calculate the WMA. Make sense? Do you want to see that code?
 

Attachments

  • WMA_output3.jpg
    WMA_output3.jpg
    155.1 KB · Views: 7
Upvote 0
OK give this a try:
The key lines are in blue.

Rich (BB code): 
Sub wma_11()

    Dim i As Long, j As Long
    Dim n As Long
    Dim wma As Double
    Dim weight As Double
    Dim sumWeight As Double
    Dim colData As Long
    Dim colWMA As Long
    Dim rowFirst As Long
    
    colData = 2 ' Column containing the data
    colWMA = 6 ' Column to output the WMA
    n = 7 ' Length of the WMA
    rowFirst = 2
    
    For i = rowFirst To Cells(Rows.Count, colData).End(xlUp).Row
        If i < n + rowFirst Then
            Cells(i, colWMA).Value = ""
        Else
            wma = 0
            weight = n
            sumWeight = (n * (n + 1)) / 2
            For j = i - n To i
                wma = wma + Cells(j, colData).Value * weight
                weight = weight - 1
            Next j
            If (i - rowFirst + 1) >= n Then
                Cells(i, colWMA).Value = wma / sumWeight
            End If
        End If
    Next i

End Sub
 
Upvote 0
Alex Blakenburg said:
OK give this a try:
The key lines are in blue.

Rich (BB code): 
Sub wma_11()

    Dim i As Long, j As Long
    Dim n As Long
    Dim wma As Double
    Dim weight As Double
    Dim sumWeight As Double
    Dim colData As Long
    Dim colWMA As Long
    Dim rowFirst As Long
   
    colData = 2 ' Column containing the data
    colWMA = 6 ' Column to output the WMA
    n = 7 ' Length of the WMA
    rowFirst = 2
   
    For i = rowFirst To Cells(Rows.Count, colData).End(xlUp).Row
        If i < n + rowFirst Then
            Cells(i, colWMA).Value = ""
        Else
            wma = 0
            weight = n
            sumWeight = (n * (n + 1)) / 2
            For j = i - n To i
                wma = wma + Cells(j, colData).Value * weight
                weight = weight - 1
            Next j
            If (i - rowFirst + 1) >= n Then
                Cells(i, colWMA).Value = wma / sumWeight
            End If
        End If
    Next i

End Sub
Click to expand...
Hi Alex, congrats! You got it working, thanks! Here are screen caps of the side by side results with the alternative code. I see that you added a new variable named rowFirst. What is the intent of this variable? Thanks, Art
 

Attachments

  • WMA_output4.jpg
    WMA_output4.jpg
    127.5 KB · Views: 1
  • WMA_output4a.jpg
    WMA_output4a.jpg
    153 KB · Views: 3
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Weighted Moving Average Calculation in VBA
Replies
5
Views
921
artz
A
K
  • Question
Previously working very complex VBA now stopped
Replies
6
Views
144
karl10220
K
J
  • Question
Combining VBA code together...need help!
Replies
3
Views
192
Fluff
Fluff
zookeepertx
  • Question
Having trouble "deciphering" some code so I can see how it works
Replies
7
Views
93
zookeepertx
zookeepertx
H
  • Solved
Amend the VBA code to Filter Columns Instead of Rows
Replies
9
Views
190
Akuini
Akuini

Forum statistics

Threads
1,215,429
Messages
6,124,840
Members
449,193
Latest member
MikeVol

Share this page

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