Median Function within VBA, which accesses an array within the function, not a cell range on the worksheet

[cuddling101]

I have read the threads about array formulas and I have tried that approach to my problem but it is not working for me. Even doing CSE on each cell and then F9 when data is changed is not working, so I gave up on that, and am now writing my own VBA.

I have the VBA function (Median_No_Zeroes) extract, by a rule, those cells that I want to produce a MEDIAN of and thus create an array, within the function, not a set of cells on the worksheet itself.

I then want to say f_Median = MEDIAN(A range of cells in my array, within the function, which I have named f_Gaps_Array)

I am just not sure of the syntax for that MEDIAN statement, would it be f_Median = MEDIAN(f_Gaps_Array(1:J)) or what, please?

The function would then return a single value to the worksheet with the following statement -

Median_No_Zeroes = f_median

I am using a function as I want to calculate this median on each new row of the spreadsheet that adds a value, to the range of values for which I am wanting the median, so the function will be called from multiple rows within the spreadsheet.

With thanks in anticipation

Philip
Bendigo, Victoria

 

[pgc01]

Hi Philip

Unfortunately there is no vba native function or operator to extract a subarray.
You have to do it yourself.

Create a new array and load it with the respective elements
It's a simple loop with copy.

Another way would be to use the worksheet index() function.

If you have difficulties post back and I'll post a solution tomorrow. In that case don't forget to say if it's a 1D or a 2D array.

 

[cuddling101]

I worked it out, but now post below what I did, just in case others have a similar issue in future -

Function Median_No_Zeroes(Start_Row As Long, End_Row As Long, _
WSName As String) As Long

Dim f_Start_Row As Long
Dim f_End_Row As Long
Dim f_Gap As Long

Dim f_Gaps_Array_Work(1 To 200) As Long
Dim f_Gaps_Array() As Long

Dim I, J, K As Long

Dim f_Median As Long

Dim f_WSName As String

f_Start_Row = Start_Row
f_End_Row = End_Row
f_WSName = WSName

I = 0
J = 0

f_Gap = 0

For I = f_Start_Row To f_End_Row

f_Gap = Worksheets(f_WSName).Cells(I, 9).Value

If f_Gap > 0 Then
J = J + 1
ReDim f_Gaps_Array(1 To J) As Long
f_Gaps_Array_Work(J) = f_Gap
End If

f_Gap = 0

Next I

For K = 1 To J

f_Gaps_Array(K) = f_Gaps_Array_Work(K)

Next K

f_Median = WorksheetFunction.Median(f_Gaps_Array)

Median_No_Zeroes = f_Median

End Function

I needed to do the Dim and Redim, and two arrays, as I only want to Median on the real values. Unfortunately the Redim function sets the whole array back to zero. I therefore had to create an array in the non-dynamic 'large' array, and then copy the real values to an array that is only as long as it needs to be, which is different for each new row from which the function is called.

I hope this maybe helps someone else one day.

Cheers

Philip

 

[pgc01]

Unfortunately the Redim function sets the whole array back to zero. I therefore had to create an array in the non-dynamic 'large' array, and then copy the real values to an array that is only as long as it needs to be, which is different for each new row from which the function is called.

Hi again

If I understand correctly, you can use PRESERVE to keep the values.

The way you usually do this is
- create an auxiliary array with the same size as the total array
- write to the auxiliary array only the elements you need
- resize the auxiliary array with preserve

This is a simple example:

Sub Test()
Dim vArray() As Long, vRealArray() As Long
Dim j As Long, k As Long

ReDim vArray(1 To 6) As Long
vArray(1) = 1: vArray(2) = 0: vArray(3) = 0 : vArray(4) = 4: vArray(5) = 0: vArray(6) = 6
ReDim vRealArray(LBound(vArray) To UBound(vArray)) As Long ' creates an auxiliary array

' copy only the values different from 0
j = LBound(vArray) - 1
For k = LBound(vArray) To UBound(vArray)
    If vArray(k) <> 0 Then
        j = j + 1
        vRealArray(j) = vArray(k)
    End If
Next k

ReDim Preserve vRealArray(LBound(vRealArray) To j) ' redim the result array, not losing the values

MsgBox Join(Application.Index(vRealArray, 0), ", ")

End Sub

HTH