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

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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: 20
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: 27
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: 17
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: 16
  • WMA_output4a.jpg
    WMA_output4a.jpg
    153 KB · Views: 15
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Weighted Moving Average Calculation in VBA
Replies
5
Views
1K
artz
A
A
  • Question Question
Counta Of Filtered Data - Errors In VBA Formula (Poor adaptation)
Replies
4
Views
62
Skyybot
Skyybot
G
  • Question Question
Why does #VALUE error in VBA function occur when creating a ReDim Matrix of Stock prices from a Named Range?
Replies
2
Views
103
Peter_SSs
Peter_SSs
S
  • Solved
Copy Textbox values from UserForm to the worksheet
Replies
6
Views
327
AlphaFrog
AlphaFrog
I
  • Solved
Irregular Data Set
2
Replies
19
Views
344
IdabaMalouki
I

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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