0

I have a working VBA code that creates an array (arr) from a range in Column B (58000 rows), splits it into an array (arr1) containing only negative values from the original array, and another array (arr2) containing only positive values from the original array. Arrays "arr1" and "arr2" are written into Columns C and D, respectively. Chosen time ranges, given in Column E and an "AdjustFactor" (Columns F and G), are put into a For loop so that I can get min and max values from each range and write the values back into Columns H and I.

What I would like to do is to search for the same min and max values without writing the arr1 and arr2 into Worksheet, i.e., the search for min and max would be performed in the arr1 and arr2 directly.

Does anyone have an idea how to do that?

Thank you in advance!

Sub Macro1()

Dim i, j, LastRow As Long
Dim arr, arr1, arr2, Time, NegativeRange, PositiveRange, NegativeMin, PositiveMin, AdjustFactor As Variant

    With Sheets("Rawdata")
        
        i = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Cells(1, 2).Resize(i, 1).Value
        arr1 = .Cells(1, 3).Resize(i, 1)
        arr2 = .Cells(1, 4).Resize(i, 1)
                
        For i = LBound(arr, 1) To UBound(arr, 1)
            arr1(i, 1) = IIf(arr(i, 1) >= 0, vblank, arr(i, 1))
            arr2(i, 1) = IIf(arr(i, 1) < 0, vblank, arr(i, 1))
        Next i
                
        .Cells(1, 3).Resize(i - 1, 1) = arr1
        .Cells(1, 4).Resize(i - 1, 1) = arr2
    
    End With
    
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
    
    AdjustFactor = Range(Cells(1, 6), Cells(LastRow, 7))
    
    PositiveMin = Range(Cells(1, 8), Cells(LastRow, 8))
    NegativeMin = Range(Cells(1, 9), Cells(LastRow, 9))
    
    For j = 1 To LastRow

        Time = Range("A:A").Find(what:=Cells(j, 5).Value, LookIn:=xlValues, LookAt:=1, MatchCase:=True).Row
        PositiveRange = Range(Cells(Time + 10 * AdjustFactor(j, 1), 4), Cells(Time + 10 * AdjustFactor(j, 2), 4))
        NegativeRange = Range(Cells(Time + 10 * AdjustFactor(j, 1), 3), Cells(Time + 10 * AdjustFactor(j, 2), 3))
        PositiveMin(j, 1) = WorksheetFunction.Min(PositiveRange)
        NegativeMin(j, 1) = WorksheetFunction.Max(NegativeRange)

    Next j

    Range(Cells(1, 8), Cells(LastRow, 8)) = PositiveMin
    Range(Cells(1, 9), Cells(LastRow, 9)) = NegativeMin

End Sub

Before running the VBA code:

enter image description here

After running the VBA code:

enter image description here

braX
  • 11,506
  • 5
  • 20
  • 33
Fevzi
  • 15
  • 4
  • `WorksheetFunction.Max` and `WorksheetFunction.Min` work perfectly fine with arrays. – BigBen Aug 02 '23 at 12:57
  • Yes, true. But I need those functions applied at 7 different sections of arr1 and arr2. So, my problem is that I don't know how to define these sections or ranges within arr1 and arr2 without writing them into the Worksheet! – Fevzi Aug 02 '23 at 13:10
  • 1
    It would seem all of it can be done with formulas in the first place? Otherwise see https://stackoverflow.com/q/11713408/11683 for referring to chunks of an array. – GSerg Aug 02 '23 at 13:27
  • I have a separate sheet with formulas performing the same operations and I use them to check if my VBA code calculations are correct. The thing is that I want to avoid the formulas altogether! Thanks for the link, I will check it and see if it gives me an idea. – Fevzi Aug 02 '23 at 13:46

1 Answers1

0

Question:What I would like to do is to search for the same min and max values without writing the arr1 and arr2 into Worksheet, i.e., the search for min and max would be performed in the arr1 and arr2 directly

Answer: By using WorksheetFunction.Index on the source array, you can get the sliced result into a new array variable without any intermediate steps (writing into cells).

    Dim lStart As Long, lEnd As Long, vaPosi, vaNega
    For j = 1 To LastRow
        Time = Range("A:A").Find(what:=Cells(j, 5).Value, LookIn:=xlValues, LookAt:=1, MatchCase:=True).Row
        lStart = Time + 10 * AdjustFactor(j, 1)
        lEnd = Time + 10 * AdjustFactor(j, 2)
        vaPosi = Application.Index(Arr2, Evaluate("ROW(" & lStart & ":" & lEnd & ")"), Array(1))
        vaNega = Application.Index(Arr1, Evaluate("ROW(" & lStart & ":" & lEnd & ")"), Array(1))
        PositiveMin(j, 1) = WorksheetFunction.Min(vaPosi)
        NegativeMin(j, 1) = WorksheetFunction.Max(vaNega)
    Next j

The code snippet demonstrates array slicing with WorksheetFunction.Index.

Sub demo()
    Dim srcArr(1 To 4, 1 To 4) As Variant, slicedArr As Variant
    Dim i As Long, j As Long
    For i = LBound(srcArr, 1) To UBound(srcArr, 1)
        For j = LBound(srcArr, 2) To UBound(srcArr, 2)
            srcArr(i, j) = i * j
        Next j
    Next i
    ' get three rows x two columns
    slicedArr = Application.Index(srcArr, Evaluate("ROW(1:3)"), Array(1, 2))
    Debug.Print "Index1", "Index2", "slicedArr(i, j)"
    For i = LBound(slicedArr, 1) To UBound(slicedArr, 1)
        For j = LBound(slicedArr, 2) To UBound(slicedArr, 2)
            Debug.Print i, j, slicedArr(i, j)
        Next j
    Next i
End Sub
taller_ExcelHome
  • 2,232
  • 1
  • 2
  • 12