Find the indices for the minimum values in a multi dimensional array in VBA

Question

In the code below I have an n x n x n array of values. I need to identify the indices that contain the minimum, second to minimum, third to minimum, ..., and put them into their own array to be used later on in the code. CC is currently defined as a 11 x 11 x 11 array and I need to identify the minimums. Below is the setup of my array CC that contains the values. n is defined as the length of the array h2s, which happens to be 11 in this case. h2st is the sum of the values in h2s.

 h2s = [1.099, 0.988, 0.7, 0.8, 0.5, 0.432, 0.8, 1.12, 0.93, 0.77, 0.658]
 h2st = 0
 n = Ubound(h2s) - Lbound(h2s) + 1

 For i = 1 to n
     h2st = h2st + h2s(i)
 Next i

 For i = 1 To n
     For j = i + 1 To n
         For k = j + 1 To n
             CC(i, j, k) = Abs(h2st - ((h2s(i) + h2s(j) + h2s(k)) * (n / 3)))
         Next k
     Next j
 Next i

How many values do you need to track - just a (relatively) small number, or do you need to rank all of them ? — Tim Williams
– Tim Williams, Commented Jun 29, 2017 at 17:20
It would be nice to be able to easily adjust the number of minimums I want, but 10 is probably a maximum. — N. Whyter
– N. Whyter, Commented Jun 29, 2017 at 17:36
Also - you could have just added this code to your previous question instead of posting a new one... — Tim Williams
– Tim Williams, Commented Jun 29, 2017 at 17:36
Creating the array to hold the values will be the easy part. I don't know how to find the matching indices. — N. Whyter
– N. Whyter, Commented Jun 29, 2017 at 17:40
I posted the same question for help in python and had a simple answer in less than an hour. Unfortunately I need to have this code in VBA. I know the SO community has a lot of knowledge and I have already spent several hours looking for an answer online with no luck so I was hoping to get some help this way. If my question gets answered I think it would be a good thing to know for others looking so I don't know why people are saying it's a bad question. — N. Whyter
– N. Whyter, Commented Jun 29, 2017 at 18:07

A.S.H · Accepted Answer · 2017-06-29 19:10:20Z

4

You can use this function that takes a multidimensional array and returns an array of its n minimum values, where n is a parameter. Importantly, the elements in the returned array are a data structure of Type Point, containing the coordinates and the value of each found point.

You can easily adjust it for finding the n max values, just by changing two characters in the code, as indicated in comments (the initialization and the comparison)

Option Explicit

Type Point
  X As Long
  Y As Long
  Z As Long
  value As Double
End Type

Function minVals(ar() As Double, nVals As Long) As Point()
  Dim i As Long, j As Long, k As Long, m As Long, n As Long, pt As Point

  'Initialize returned array with max values.
  pt.value = 9999999# ' <-------- change to -9999999# for finding max
  ReDim ret(1 To nVals) As Point
  For i = LBound(ret) To UBound(ret): ret(i) = pt: Next

  For i = LBound(ar, 1) To UBound(ar, 1)
    For j = LBound(ar, 2) To UBound(ar, 2)
      For k = LBound(ar, 3) To UBound(ar, 3)

        ' Find first element greater than this value in the return array
        For m = LBound(ret) To UBound(ret)
          If ar(i, j, k) < ret(m).value Then ' <------- change to > for finding max
            ' shift the elements on this position and insert the current value
            For n = UBound(ret) To m + 1 Step -1: ret(n) = ret(n - 1): Next n
            pt.X = i: pt.Y = j: pt.Z = k: pt.value = ar(i, j, k)
            ret(m) = pt
            Exit For
          End If
        Next m
      Next k
    Next j
  Next i
  minVals = ret
End Function

Sub Test()
  Dim i As Long, j As Long, k As Long, pt As Point
  Const n As Long = 11

  ReDim CC(1 To n, 1 To n, 1 To n) As Double
  For i = 1 To n
    For j = 1 To n
      For k = 1 To n
        CC(i, j, k) = Application.RandBetween(100, 100000)
      Next k
    Next j
  Next i

  ' Testing the function: get the smalles 5 values and their coordinates
  Dim mins() As Point: mins = minVals(CC, 5)

  ' Printing the results
  For i = LBound(mins) To UBound(mins)
    Debug.Print mins(i).value, mins(i).X, mins(i).Y, mins(i).Z
  Next
End Sub

edited Jun 29, 2017 at 19:10

answered Jun 29, 2017 at 18:09

A.S.H

29.4k6 gold badges25 silver badges50 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

N. Whyter Over a year ago

I'm getting a Compile Error and Type Error: array or user-defined type expected.

N. Whyter Over a year ago

That was fixed actually. This code is amazing. Thanks!

Collectives™ on Stack Overflow

Find the indices for the minimum values in a multi dimensional array in VBA

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related