I sometimes work with symmetric matrices in MS-Excel (both v2007 and v2003).
Is there an option to help me to copy expressions from the lower triangle to the upper one?
It should be something like copy and paste/transponse but those functions normally work only with rectangular areas.
in the added picture you can see an exemple of an expression that I have to replicate by linking the symmetric value in the superior triangle of the matrix.
To get the number in the appropriate cell, we can use OFFSET and the cell address the forms the base of the table. Note that the formula will produce a *Circular Reference` error if entered in on the diagonal. The formula will work for both sides of the diagonal - you just have to decide which one will hold the data, and which will hold the formula.
Offset takes Row and Column to decide the target. By subtracting the base cell row and column from the current position, we can invert the row and columns, and get the data.
Using your example, with the origin of the table in B2, we end up with the following formula:
=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
you can copy this formula into the cells, and get the reflection. Now you have the number, you can do any calculation you require on the reflection. Using your example, this would make the formula:
=10-OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
Result:
Using INDEX to make it non volatile would change the formula slightly. First, we would need a reference to the entire table, not just the top cell. Second, we would need to add 1 to the row/column calculation, as it refers to the first cell as row/column 1, not an offset of 0 as the previous formula.
=INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
and your example of 10-Cell would become:
=10-INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
As one of the above answers demonstrates, this can be done by using Excel formulas. I however find this to be a very tedious procedure. Especially if this is something you need to do on a regular basis. In that case VBA could save you a lot of time.
The following code will work on a square selection and fill the rest of the matrix no matter if it is the lower- or upper part of the matrix that is pre-filled.
Option Explicit
Sub FillSymetricMatrix()
Dim i As Integer, j As Integer
Dim SelRng As Range
Dim FillArea As String
Dim FRow As Integer
Dim FCol As Integer
Set SelRng = Selection
FRow = SelRng.Rows(1).Row
FCol = SelRng.Columns(1).Column
'Returns information about which area to fill
If ActiveSheet.Cells(FRow + SelRng.Rows.Count - 1, FCol).Value <> vbNullString Then 'Lower filled
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value = vbNullString Then 'Upper empty
FillArea = "Upper"
Else
FillArea = "Error"
End If
Else
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value <> vbNullString Then 'Upper filled
FillArea = "Lower"
Else
FillArea = "Error"
End If
End If
'Determines if the selection is square
If SelRng.Rows.Count <> SelRng.Columns.Count Then FillArea = "Error"
'Fills empty area of the square (symetric) matrix
Select Case FillArea
Case Is = "Upper"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(i + FRow, j + FCol).Value = ActiveSheet.Cells(j + FRow, i + FCol).Value
Next j
Next i
Case Is = "Lower"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(j + FRow, i + FCol).Value = ActiveSheet.Cells(i + FRow, j + FCol).Value
Next j
Next i
Case Else
MsgBox "The procedure cannot be performed on the current selection!"
End Select
End Sub
I guess what you need is a function which returns the "diagonal" value of a square matrix, e.g. for any X(j,k) return X(k,j)
Try this:
Function DIAGONAL(Arg As Range, Reference As Range) As Variant
Dim MyRow As Long, MyCol As Long
If Reference.Rows.Count <> Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrRef)
Else
MyRow = Arg.Row - Reference.Row + 1
MyCol = Arg.Column - Reference.Column + 1
If MyRow < 1 Or MyCol < 1 Or MyRow > Reference.Rows.Count Or MyCol > Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrNA)
Else
DIAGONAL = Reference(MyCol, MyRow)
End If
End If
End Function
once you entered this function in VBA, you can use it inside or outside your square matrix ... you just need to ensure that your argument (parameter: Arg) is within the matrix (parameter: Reference) ... or you get an #N/A error. Or you get a #REF error if the matrix isn't square.
So in your example you would enter into B4: =10-DIAGONAL(B4,$B$2:$K$11) and copy this throughout the lower triangle.
You can even transpose a complete matrix ... in your screen shot, move to cell B13, enter =DIAGONAL(B2,$B$2:$K$11) and copy 9x down & right
No buttons, no need to explicitely start a Sub ... any size of n x n matrix, handles strings and numbers, ...
Here is an example with VBA. Start with an un-filled table and a button.
Then make the button run the code:
Option Explicit
Private Sub symmButton_Click()
MakeSymmetric Range("B2")
End Sub
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = CountCols(r)
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(i, j) = vals(j, i)
Next j
Next i
r.Resize(M, M).Value2 = vals
End Sub
Public Function CountCols(ByRef r As Range) As Long
If IsEmpty(r) Then
CountCols = 0
ElseIf IsEmpty(r.Offset(0, 1)) Then
CountCols = 1
Else
CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count
End If
End Function
and finally observe the results
Similar to Sean's solution, I would also use formulas. In order to get the transposed value, use this formula:
=INDEX($B$2:$G$7,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
If you want to do a more complex operation (e.g. =10-[transposedValue]), I'd recommend you use a named range: Insert a new name, e.g. TransposedValuein the Name Manager. Instead of a cell link, provide the above formula. Now you can literally write the following formula in your matrix:
=10-TransposedValue
I have this way. As you said copy paste transpose work on rectangular range. And your problem is that you have a triangular range.
You will love this....
1). Select the square range containing your upper triangular matrix and Copy.
2). Select a cell in an empty place and do the following two steps
a.) Paste Special - Values
b.) Paste Special - Values - Transpose - Skip Blanks
And you have got your symmetric matrix :-)
Anil.
Mixing together Ja72's fill code with SeanC c's Excel function code, I think I can make a generic matrix template that is properly prefilled with the dynamic Excel formula. So dynamic, and can be reused without any copy and paste.
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = 300
' Was CountCols(r), but I just limited to 300 columns for now
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(j, i) = "=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))"
Next j
'Make diagonal down the middle show ---
vals(j, i) = "---"
Next i
vals(1, 1) = "---"
r.Resize(M, M).Value2 = vals
End Sub
Sub FillSymmetric()
MakeSymmetric Range("B2")
End Sub
I don't really know any VB though, so I haven't quite figured out how to fill the header yet. I don't know Stackoverflow yet either, but I will try to add a picture.
Original List to Matrixize
Dynamically transposing values typed in SouthWest half to NorthEast half
Short answer: INDIRECT(ADDRESS(COLUMN(D2), ROW(D2)))
Explnation: you may remember we use coordinates with numbers to represent a location in Cartesian Coordinates System. So, it's easy to get a diagonal symmetric value e.g. just change (2, 3) to (3, 2).
But in Excel, we need a wordaround if we want to do so. Because, address is marked by a combination of a letter and a digit, say B2. You can't just change B2 to 2B.
Luckily, we can still use numbers to represent a cell by leveraging the power of COW() and COLUMN().
In the image below, C2 and B3 are symmetrical. This shows how to put the value of C2 to B3.
Making the formula from C.W. more generic (similar to Peter Albert), this will help when your matrix is not starting at A1 but e.g. in C10:
=INDIRECT(ADDRESS(COLUMN(C11)-COLUMN($C$10)+1,ROW(C11)-ROW($C$10)+1))
So, subtract the origin row/column and add 1.
Related
I'm trying to solve a problem in VBA and after a long time of browsing the web for solutions, I really hope someone is able to help me.
It's actually not a very hard task, but with very little programming and VBA knowledge as a new learner, I hope I can find a useful tip or solution with the help of the community.
So my problem is as follows:
I have a table with 3 columns, the first is filled with a number to use as an ID. Column 2 and 3 have different values that needs to be compared:
What I'd like to do is select the range of column rows of column 2 and 3 based on the same ID. Once I have selected the relevant ranges of the columns, I want to compare if one name of column 2 matches one name of column 3.
So there is no need to have all names of the desired column ranges to match. One name match is enough. If a name matches, it should automatically fill in a new column "result" with 1 for match (0 for no match).
Do you have an idea, how I can select specific cells of a column based on an identifier?
Dim ID_counter As Long
ID_counter = 1
If Cell.Value = ID_counter IN Range("Column1")
Then Range("Column2").Select
AND Range("Column3").Select
WHERE ID_counter is the same
In Column4 (If one Cell.Value IN Range("Column2-X:Column2-Y")
IS IDENTICAL TO Range("Column3-X:Column3-Y"), return 1, else return 0
End Sub
Many thanks in advance for your help!
This works for your example so perhaps you can generalise it. The formula in D2 is
=IF(A2=A1,"",MAX(IF($A$2:$A$10=A2,COUNTIF($B$2:$B$10,$C$2:$C$10))))
and is an array formula so must be confirmed with CTRL, SHIFT and ENTER.
Array alternative via Match() function
This approach compares the string items of columns B and C by passing two arrays (named b,c) as arguments (c.f. section [1]):
chk = Application.Match(b, c, 0)
The resulting chk array reflects all findings of the first array's items via (1-based) position indices of corresponding items in the second array.
Non-findings return an Error 2042 value (c.f. section [2]b)); assumption is made that data are grouped by id.
Sub OneFindingPerId()
'[0]get data
Dim data: data = Sheet1.Range("A1:D10") ' << project's sheet Code(Name)
Dim b: b = Application.Index(data, 0, 2) ' 2nd column (B)
Dim c: c = Application.Index(data, 0, 3) ' 3rd column (C)
'[1]get position indices of identic strings via Match() function
Dim chk: chk = Application.Match(b, c, 0) ' found row nums of a items in b
'[2]loop found position indices (i.e. no error 2042)
Dim i As Long
For i = 2 To UBound(chk) ' omit header row
'a) define start index of new id and initialize result with 0
If data(i, 1) <> data(i - 1, 1) Then
Dim newId As Long: newId = i
data(newId, 4) = 0
End If
'b) check if found row index corresponds to same id
If Not IsError(chk(i, 1)) Then ' omit error 2042 values
If data(chk(i, 1), 1) = data(i, 1) Then ' same ids?
If data(newId, 4) = 0 Then data(newId, 4) = 1 ' ~> result One if first occurrence
End If
End If
Next i
'[3]write results
Sheet1.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
First enter this user defined function in a standard module:
Public Function zool(r1, r2, r3) As Integer
Dim i As Long, v1 As Long, v2 As String
Dim top As Long, bottom As Long
zool = 0
v1 = r1.Value
top = r1.Row
' determine limits to check
For i = top To 9999
If v1 <> r1.Offset(i - top, 0).Value Then
Exit For
End If
Next i
bottom = i - 1
For i = top To bottom
v2 = Cells(i, "B").Value
If v2 <> "" Then
For j = top To bottom
If v2 = Cells(j, "C").Value Then zool = 1
Next j
End If
Next i
End Function
Then in D2 enter:
=IF(OR(A2="",A2=A1),"",zool(A2,B2,C2))
and copy downwards:
(this assumes that the data has been sorted or organized by ID first)
Ive been trying to make something in Excel to find multiple combinations of sums.
I have list of numbers that needs to be added together to be either within ranges of 500-510 or 450-460.
Only two numbers from the list can be used to find the sum. the numbers can not be used more than once. and giving the combinations of multiple results would be great. and if a number is not used it is ok.
I've tried the solver add-in and some other tips I found from this site but could not find something that gives multiple answers.
Does anyone know if this will be possible?
I'd break this into 2 tasks. First would be to simply generate all of the index pairs to test in the input array. That's relatively simple with recursive procedure. This one uses a private Type to store the pairs, but it could adapted to use some other method of storing the pairs:
Private Type Tuple
ValueOne As Long
ValueTwo As Long
End Type
Private Sub FindCombinations(elements As Long, ByRef results() As Tuple, _
Optional ByVal iteration As Long = 0)
If iteration = 0 Then ReDim results(0)
Dim idx As Long
For idx = iteration To elements - 1
Dim combo As Tuple
With combo
.ValueOne = iteration
.ValueTwo = idx
End With
results(UBound(results)) = combo
If iteration <> elements And idx <> elements Then
ReDim Preserve results(UBound(results) + 1)
End If
Next
If iteration < elements Then FindCombinations elements, results, iteration + 1
End Sub
Then, you use a "entry-point" procedure to generate the index combinations, use those to index into your source array, and apply your selection criteria:
Private Sub FindMatchingSets(testSet() As Long)
Dim indices() As Tuple
FindCombinations UBound(testSet) + 1, indices
Dim idx As Long, results() As Tuple
For idx = LBound(indices) To UBound(indices)
Dim tupleSum As Long
tupleSum = testSet(indices(idx).ValueOne) + testSet(indices(idx).ValueTwo)
If indices(idx).ValueOne <> indices(idx).ValueTwo And _
((tupleSum >= 500 And tupleSum <= 510) Or _
(tupleSum >= 450 And tupleSum <= 460)) Then
Debug.Print testSet(indices(idx).ValueOne) & " + " & _
testSet(indices(idx).ValueTwo) & " = " & tupleSum
End If
Next
End Sub
It isn't clear what you intend to do with the results, so this simply outputs the calculated values to the Immediate Window. Example calling code:
Private Sub Example()
Dim test(4) As Long
test(0) = 100
test(1) = 200
test(2) = 250
test(3) = 260
test(4) = 400
FindMatchingSets test
End Sub
May modify it according to your need & try
Sub test()
Dim X, Y, TRw, GotNum, First, Second As Long
TRw = 1
With ThisWorkbook.ActiveSheet
For X = 1 To 100 ' assumed col A1 to A100 is the list
GotNum = .Cells(X, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
.Cells(X, 1).Font.Color = RGB(255, 0, 0)
First = GotNum
For Y = X + 1 To 100
GotNum = .Cells(Y, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
Second = GotNum
TRw = TRw + 1
.Cells(TRw, 3).Value = First ' write 1st Number in Col C
.Cells(TRw, 4).Value = Second ' write 2nd Number in Col D
.Cells(TRw, 5).Value = First + Second ' write Sum of 1st & 2nd in Col C
End If
Next Y
End If
Next X
End With
End Sub
I think your question needs to be a little clearer in terms of what your expected output is (do you want a list of combos, or just to see the results?), but here's my solution.
I've put a list of 20 numbers in column Y, and assigned them all a letter (a through to t) in column X
Then I've built a matrix of the combinations of a to t, and have entered the following formula (the below is for cell C3, but it can be copied and pasted into all parts of the matrix)
=IF(C$2=$B3,"x",VLOOKUP(C$2,$X:$Y,2,FALSE)+VLOOKUP($B3,$X:$Y,2,FALSE))
I've then used conditional formatting to set the colour of the cells if they meet your criteria for the sum - you can do this by highlighting all the sums (cell C3:V22) and going to
home / conditional formatting / new rule...
picking the rule type format only cells that contain
and then in the drop down menus picking Cell Value / Between / Your high range
and then selecting a format (fill background colour, usually)
Do this once for the "high" sum, and once for the "low" sum. You can make the colours the same or different, depending on what you want to see.
I've also for reference included a reference to what the number is in Row 1 and column A. The formula for row 1 is (example is for C1, but it can be copied across)
=VLOOKUP(C2,$X:$Y,2,FALSE)
And the formula for column A is (example for A3) =VLOOKUP(B3,$X:$Y,2,FALSE)
The advantage of this approach is that it's all in excel (no code required), but the disadvantage is that it's hard to get a list of results. You could use a different formula to just return the sum (e.g. return the text "205+298") when it meets one of the conditions, but then it's still a pain to get it out of the matrix format and into a single list. Much easier using VBA
In this VBA program all I am trying to do is to pass an array from spreadsheet and add 1 to each of the array's cells. My problem is with the index of the array. when I start looping the array it doesnt
work when I start the index from zero ( I get error subscript out of range) but it works perfectly when I start the array from 1. Why is that? (I thought that would be the case only I specify at the top Option Base 1)
Sub Passarray()
Dim Array As Variant
Dim i, j As Integer
'Pass array and manipulate
Vol = Range("Volatility")
For i = 0 To 2
For j = 0 To 2
Vol(i, j) = 1+ Vol(i,j)
Next j
Next i
End Sub
That wasn't the case when you pass Range to arrays based on my experience.
I don't know the specific reason behind, but this link indicates that you cannot change this behavior.
QUOTE: The array into which the worksheet data is loaded always has an lower bound (LBound) equal to 1, regardless of what Option Base directive you may have in your module. You cannot change this behavior.
What you can do is to utilize the use of LBound/UBound like this:
Vol = Range("Volatility")
For i = LBound(Vol, 1) To UBound(Vol, 1)
For j = Lbound(Vol, 2) To Ubound(Vol, 2)
'~~> do stuff here
Vol(i, j) = 1 + Vol(i, j)
Next j
Next i
If however your Range is just one column with several rows, you pass it to Array like this:
Vol = Application.Transpose(Range("Volatility"))
For i = LBound(Vol) To UBound(Vol)
'~~> do stuff here
Vol(i) = 1 + Vol(i)
Next
This way, you will produce one-D array instead of two-D array.
To iterate values you can use above or you can also use For Each:
Dim x As Variant '~~> dimension another variant variable
For Each x In Vol
'~~> do stuff here
x = 1 + x
Next
I'm trying to generate words in Column B from a list of given words in Column A.
Right now my code in Excel VBA does this:
Function GetText()
Dim GivenWords
GivenWords = Sheets(1).Range(Sheets(1).[a1], Sheets(1).[a20])
GetText = A(Application.RandBetween(1, UBound(A)), 1)
End Function
This generates a word from the list I have provided in A1:A20, but I don't want any duplicates.
GetText() will be run 15 times in Column B from B1:B15.
How can I check for any duplicates in Column B, or more efficiently, remove the words temporarily from the list once it has been used?
For example,
Select Range A1:A20
Select one value randomly (e.g A5)
A5 is in Column B1
Select Range A1:A4 and A6:A20
Select one value randomly (e.g A7)
A7 is in Column B2
Repeat, etc.
This was trickier than I thought. The formula should be used as a vertical array eg. select the cells where you want the output, press f2 type =gettext(A1:A20) and press ctrl+shift+enter
This means that you can select where your input words are in the worksheet, and the output can be upto as long as that list of inputs, at which point you'll start getting #N/A errors.
Function GetText(GivenWords as range)
Dim item As Variant
Dim list As New Collection
Dim Aoutput() As Variant
Dim tempIndex As Integer
Dim x As Integer
ReDim Aoutput(GivenWords.Count - 1) As Variant
For Each item In GivenWords
list.Add (item.Value)
Next
For x = 0 To GivenWords.Count - 1
tempIndex = Int(Rnd() * list.Count + 1)
Aoutput(x) = list(tempIndex)
list.Remove tempIndex
Next
GetText = Application.WorksheetFunction.Transpose(Aoutput())
End Function
Here's how I would do it, using 2 extra columns, and no VBA code...
A B C D
List of words Rand Rank 15 Words
Apple =RAND() =RANK(B2,$B$2:$B$21) =INDEX($A$2:$A$21,MATCH(ROW()-1,$C$2:$C$21,0))
copy B2 and C2 down as far as the list, and drag D down for however many words you want.
Copy the word list somewhere, as every time you change something on the sheet (or recalculate), you will get a new list of words
Using VBA:
Sub GetWords()
Dim Words
Dim Used(20) As Boolean
Dim NumChosen As Integer
Dim RandWord As Integer
Words = [A1:A20]
NumChosen = 0
While NumChosen < 15
RandWord = Int(Rnd * 20) + 1
If Not Used(RandWord) Then
NumChosen = NumChosen + 1
Used(RandWord) = True
Cells(NumChosen, 2) = Words(RandWord, 1)
End If
Wend
End Sub
Here is the code. I am deleting the cell after using it. Please make a backup of your data before using this as it will delete the cell contents (it will not save automatically...but just in case). You need to run the 'main' sub to get the output.
Sub main()
Dim i As Integer
'as you have put 15 in your question, i am using 15 here. Change it as per your need.
For i = 15 To 1 Step -1
'putting the value of the function in column b (upwards)
Sheets(1).Cells(i, 2).Value = GetText(i)
Next
End Sub
Function GetText(noofrows As Integer)
'if noofrows is 1, the rand function wont work
If noofrows > 1 Then
Dim GivenWords
Dim rowused As Integer
GivenWords = Sheets(1).Range(Sheets(1).Range("A1"), Sheets(1).Range("A" & noofrows))
'getting the randbetween value to a variable bcause after taking the value, we can delete the cell.
rowused = (Application.RandBetween(1, UBound(GivenWords)))
GetText = Sheets(1).Range("A" & rowused)
Application.DisplayAlerts = False
'deleting the cell as we have used it and the function should not use it again
Sheets(1).Cells(rowused, 1).Delete (xlUp)
Application.DisplayAlerts = True
Else
'if noofrows is 1, there is only one value left. so we just use it.
GetText = Sheets(1).Range("A1").Value
Sheets(1).Cells(1, 1).Delete (xlUp)
End If
End Function
Hope this helps.
I want to calculate a moving average of the last, say 20, numbers of a column. A problem is that some of the cells of the column may be empty, they should be ignored. Example:
A
175
154
188
145
155
167
201
A moving average of the last three would be (155+167+201)/3. I've tried to implement this using average, offset, index, but I simply don't know how. I'm a little bit familiar with macros, so such a solution would work fine: =MovingAverage(A1;3)
Thanks for any tips or solutions!
{=SUM(($A$1:A9)*(ROW($A$1:A9)>LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1)))/3}
Enter this with control+shift+enter to make it an array formula. This will find the latest three values. If you want more or less, change the two instances of '3' in the formula to whatever you want.
LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1)
This part returns the 4th highest row number of all the cells that have a value, or 5 in your example because rows 6, 8, and 9 are the 1st through 3rd highest rows with a value.
(ROW($A$1:A9)>LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1))
This part returns 9 TRUEs or FALSEs based on whether the row number is larger than the 4th largest.
($A$1:A9)*(ROW($A$1:A9)>LARGE((ROW($A$1:A9))*(NOT(ISBLANK($A$1:A9))),3+1))
This multiplies the values in A1:A9 by those 9 TRUEs or FALSEs. TRUEs are converted to 1 and FALSEs to zero. This leaves a SUM function like this
=SUM({0;0;0;0;0;155;0;167;201})/3
Because all the values above 155 don't satisfy the row number criterion, the get multiplied by zero.
If you are going to use a UDF it will only recalculate correctly when you change the data if the parameters include all the range of data you want to handle.
Here is a moving average UDF that handles entire columns and contains some error handling. You can call it using by entering the formula =MovingAverage(A:A,3) into a cell.
Function MovingAverage(theRange As Range, LastN As Long) As Variant
Dim vArr As Variant
Dim j As Long
Dim nFound As Long
Dim dSum As Double
On Error GoTo Fail
MovingAverage = CVErr(xlErrNA)
'
' handle entire column reference
'
vArr = Intersect(Application.Caller.Parent.UsedRange, theRange).Value2
If IsArray(vArr) And LastN > 0 Then
For j = UBound(vArr) To 1 Step -1
' skip empty/uncalculated
If Not IsEmpty(vArr(j, 1)) Then
' look for valid numbers
If IsNumeric(vArr(j, 1)) Then
If Len(Trim(CStr(vArr(j, 1)))) > 0 Then
nFound = nFound + 1
If nFound <= LastN Then
dSum = dSum + CDbl(vArr(j, 1))
Else
Exit For
End If
End If
End If
End If
Next j
If nFound >= LastN Then MovingAverage = dSum / LastN
End If
Exit Function
Fail:
MovingAverage = CVErr(xlErrNA)
End Function
Just a quick solution:
Supposing your numbers are on the cells A2:A10, put in B10 the following formula:
=IF(COUNT(A8:A10)=3,AVERAGE(A8:A10),IF(COUNT(A7:A10)=3,AVERAGE(A7:A10),"too many blanks"))
Dragging up the formula you get the moving average
If there is the possibility of two consecutive blank you could nest another if, more than that and this solution became too complicated
I have written a short script in VBA. Hopefull it does what you want. Here you are:
Function MovingAverage(ByVal r As String, ByVal i As Integer) As Double
Dim rng As Range, counter As Long, j As Integer, tmp As Double
Set rng = Range(r)
counter = 360
j = 0
tmp = 0
While j < i + 1 And counter > 0
If Len(rng.Offset(j, 0)) > 0 Then
tmp = tmp + rng.Offset(j, 0).Value
End If
j = j + 1
counter = counter - 1
Wend
MovingAverage = CDbl(tmp / i)
End Function
1) I have set limit to 360 cells. It means that the script will not look for more than 360 cells. If you want to change it then change the initial value of counter.
2) The script returns not rounded average. Change the last row to
MovingAverage = Round(CDbl(tmp / i),2)
3) The use is just like you wanted, so just type =MovingAverage("a1";3) into the cell.
Any comments are welcome.