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):
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 existingValueArray
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 andTempValue
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 theTempValue
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 theOutputArray
. - Second is checking if the
TempValue
calculation evaluates to less than x -MaxValue
. If Yes it returnsTempValue
to theOutputArray
. - Else, we return x -
MaxValue
to theOutputArray
.
Outcome of the above code;
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