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:
After running the VBA code: