Home > Net >  3 nested loops in an array - VBA
3 nested loops in an array - VBA

Time:12-02

I have 2 nested loops in an array but as far as I understand I need third which I am not able to implement.

I have following data (in yellow):

enter image description here

Current code calculates as indicated in column Actual Behavior:

Dim arr, outarr as Variant
Dim lastc, lastr as long

lastc = 2
lastr = Cells(ws.Rows.count, lastc).End(xlUp).Row
    arr = Range(Cells(2, lastc), Cells(lastr, lastc))
      cnt = ((UBound(arr, 1) - 1) * UBound(arr, 1)) / 2
          k = 1
            ReDim outarr(1 To cnt, 1 To 1)
                For i = LBound(arr, 1)   1 To UBound(arr, 1)
                       For j = LBound(arr, 1) To i - 1
                             outarr(k, 1) = arr(j, 1) - arr(i, 1)
                                
        k = k   1
                        Next j
              Next i

Desired behavior would be for values from 1.1 to 6.1 to store minimum value in that range as a result. 10 - 0 = 10 but I need actual minimum value in that range (1.6 to 6.6) and minimum value would be 10 - 40 = -30.

It's really important that minimum value is always calculated as first value of a range - X value of a range. First value in given loop is a constant.

I believe that third loop is needed to store minimum value and then insert this value to outarr but I've not been successful yet.

Thank you for your help.

CodePudding user response:

I believe this outputs the desired results.

Rather than adding a 3rd nested loop to the mix I've added an additional helper loop into the first level.

Please note: This should give you a good idea how to approach this with less complexity than another layer of For Next loop but due to positioning, performance will degrade as the iterations grow.

I've renamed some variables to be more descriptive (except x because I got lazy).

Explation is below the code, here is the re-worked loop section.

OutputCounter = 1
For LayerOneStep = LBound(ValueArray, 1) To UBound(ValueArray, 1)
    ReDim TempArray(1 To LayerOneStep)
    For x = 1 To UBound(TempArray)
        TempArray(x) = ValueArray(x, 1)
    Next x
    For LayerTwoStep = LBound(ValueArray, 1) To LayerOneStep - 1
        MaxValue = WorksheetFunction.Max(TempArray)
        TempValue = (ValueArray(LayerOneStep, 1) - ValueArray(LayerTwoStep, 1))
        If ValueArray(LayerOneStep, 1) = 0 Or ValueArray(LayerTwoStep, 1) = 0 Then
            OutputArray(OutputCounter) = TempValue
            OutputCounter = OutputCounter   1
        ElseIf TempValue < ValueArray(LayerOneStep, 1) - MaxValue Then
            OutputArray(OutputCounter) = TempValue
            OutputCounter = OutputCounter   1
        Else
            OutputArray(OutputCounter) = ValueArray(LayerOneStep, 1) - MaxValue
            OutputCounter = OutputCounter   1
        End If
    Next LayerTwoStep
Next LayerOneStep
  • TempArray() is used to store your grouped values. I.e. B3 & B2 or B5 & B4 & B3 & B2, etc. This is achieved by assigning the values from Column B row 2 to whatever the LayerOne counter is up to row. The values are assigned from the existing ValueArray array rather than accessing the worksheet again each time.
  • Assigning it this way allows us to use the WorksheetFunction.Max() function to find the largest number in the set. (keep in mind, as above, not the most performance based way)
  • We then use some variables to assign some calculations to. The MaxValue as above and TempValue being the x-y approach - same outcome as the worksheet formulas.
  • We then us some If...Then...Else logic to start working out the absolute minimum value based on the calculation range.
  • Fist If conditions are checking if either value as part of the TempValue calculation is zero (0). If it is, it returns some funky results so this ensures we go with the x - 0 or 0 - y outcome to the OutputArray.
  • Second is checking if the TempValue calculation evaluates to less than x - MaxValue. If Yes it returns TempValue to the OutputArray.
  • Else, we return x - MaxValue to the OutputArray.

Outcome of the above code;

Snip of results of executed code written back to worksheet

CodePudding user response:

Instead of making another loop, I keep a record of the lowest value within each loop and compare against the new value in the inner loop:

Option Explicit

Private Sub Test()
    Const startRow As Long = 2
    Const valueCol As Long = 2
    Const outputCol As Long = 4
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
        
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, valueCol).End(xlUp).Row
    
    Dim inputArr As Variant
    inputArr = ws.Range(ws.Cells(startRow, valueCol), ws.Cells(lastRow, valueCol)).Value
    
    Dim outputSize As Long
    outputSize = ((UBound(inputArr, 1) - 1) * UBound(inputArr, 1)) / 2
    
    Dim outputIndex As Long
    Dim outputArr As Variant
    ReDim outputArr(1 To outputSize, 1 To 1) As Variant
    
    Dim i As Long
    Dim n As Long
    
    Dim currFirst As Long
    Dim currLowest As Long
    
    For i = 2 To UBound(inputArr, 1)
        currFirst = inputArr(i, 1)
        currLowest = currFirst - inputArr(i - 1, 1)
                
        For n = i - 1 To 1 Step -1
            Dim testLowest As Long
            testLowest = currFirst - inputArr(n, 1)
            
            If testLowest < currLowest Then currLowest = testLowest
            
            outputIndex = outputIndex   1
            outputArr(outputIndex, 1) = currLowest
        Next n
    Next i
    
    ws.Cells(startRow, outputCol).Resize(UBound(outputArr, 1)).Value = outputArr
End Sub

enter image description here

  • Related