This is a slightly more sane version of the single line macro idea from here
https://excelfox.com/forum/showthrea...ll=1#post15420
https://excelfox.com/forum/showthrea...ll=1#post15421
Code:
Sub SlightlySanerVersion()
Dim arrStrTemp() As String: Let arrStrTemp() = Split(Replace(Replace(Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=$I$1),0)*($A$2:$A$1000=$I$1)),ROW(F2:F463),0)"), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")), "#"), "0#", ""), "#0", ""), "#")
Dim arrTemp() As Variant: Let arrTemp() = Application.Index(Worksheets("Sheet1").Columns(6), Application.Index(arrStrTemp(), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")/row(1:" & UBound(arrStrTemp()) + 1 & ")"), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")")), 1)
Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp()
Stop
Range("T2").Resize(UBound(arrTemp(), 1), 1).ClearContents
' Or
Dim UnicNm As String: Let UnicNm = "aa"
Let arrStrTemp() = Split(Replace(Replace(Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=" & """" & UnicNm & """" & "),0)*($A$2:$A$1000=$I$1)),ROW(F2:F463),0)"), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")), "#"), "0#", ""), "#0", ""), "#")
Let arrTemp() = Application.Index(Worksheets("Sheet1").Columns(6), Application.Index(arrStrTemp(), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")/row(1:" & UBound(arrStrTemp()) + 1 & ")"), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")")), 1)
Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp()
End Sub
We can use the basic idea above to make a function idea to do the same
Code:
Sub UseNotSoInsaneFunction()
Dim arrTemp() As Variant
Let arrTemp() = NotSoInsane("aa")
Range("T2").Resize(UBound(arrTemp(), 1), 1).ClearContents
Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp()
End Sub
Function NotSoInsane(ByVal Nme As String) As Variant
Dim arrStrTemp() As String: Let arrStrTemp() = Split(Replace(Replace(Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=" & """" & Nme & """" & "),0)*($A$2:$A$1000=$I$1)),ROW(F2:F463),0)"), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")), "#"), "0#", ""), "#0", ""), "#")
Dim arrTemp() As Variant: Let arrTemp() = Application.Index(Worksheets("Sheet1").Columns(6), Application.Index(arrStrTemp(), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")/row(1:" & UBound(arrStrTemp()) + 1 & ")"), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")")), 1)
Let NotSoInsane = arrTemp()
End Function
Bookmarks