Code:
Sub Pretty3bbProbSolved() ' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15426&viewfull=1#post15426
Dim arrTemp() As Variant
Rem To get the results in column T ( same as
' Ths first forumula give me all the matches for F in the C ( helper column ) or error for no match
Let arrTemp() = Evaluate("=If({1},MATCH(F2:F463,C2:C463,0))") ' If({1},____) may not be needed for Excel 2016 and higher The first formula does the main work
' The multiplication by $A$2:$A$1000=$I$1 limits the range used by effectively making 0 check dates outside or range of interest
Let arrTemp() = Evaluate("=IF({1},MATCH(F2:F463,C2:C463*($A$2:$A$1000=$I$1),0))") ' $A$2:$A$1000=$I$1 gives us an array full of Falses and Trues , which Excel will interpret mathematically as 0 or 1 This has the effect of giving us a 0 multiplyer on numbers outside our range of interst, so in total a 0 for outside our range of interest. Our range of interest gets a 1 multiplier so has therefore no change and we can find those numbers whereas we wont find a 0, well actually we will find a zero if the range to search for has a zero as it does further down, so we take care of that in the next line
' The above formula has one problem with the supplied data in that empty cells are seen in this formula as 0 which gives a match
Let arrTemp() = Evaluate("=IF(F2:F463=0,0,MATCH(F2:F463,C2:C463*($A$2:$A$1000=$I$1),0))") ' In looking in the range to find a match in ( the range to be searched we have all 0s outside the range caused by the previous $A$2:$A$1000=$I$1 So the first of these 0s will be seen as the match cell for all cells in F that are empty. So i take care here of the situation where an empty cell in F is by giving a 0 output So far two things retrn me a zero. You often find in formula building that the coercing If({1},___) suddenly is not needed. Her we find that the newly used here IF(F2:F463=0,0,___) is doing the required co oecing
' we will now do a simple If(ISERROR( ) , Row( ) , 0 ) on the above . This will give us a row indicie for the missing data, and a 0 for the found data
Let arrTemp() = 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)")
' At this point we have wanted data or zeros. I want to conveniently use some VB string fuction whuch annoyingly onl work on 1 D arrays, so we convert it by a transpose in the next code line
Let arrTemp() = Application.Index(arrTemp(), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)"))
' Or
Let arrTemp() = 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)"))
' The next few lines get rid of the 0s
Dim StrTemp As String: Let StrTemp = "_" & Join(arrTemp(), "#") ' Convert the array to a string with a # in between each data
Let StrTemp = Replace(StrTemp, "_0#", "_", 1, 1, vbBinaryCompare): StrTemp = Replace(StrTemp, "#0", "", 2, -1, vbBinaryCompare) ' This effectiveely removes the 0s data ( and its seperator )
Dim arrStrTemp() As String: Let arrStrTemp() = Split(StrTemp, "#", -1, vbBinaryCompare) ' remake the array
' Or
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", "", 2), "#")
' We need a "vertical" array for output, so we transpose
Let arrTemp() = Application.Index(arrStrTemp(), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")/row(1:" & UBound(arrStrTemp()) + 1 & ")"), Evaluate("=row(1:" & UBound(arrStrTemp()) + 1 & ")"))
Let arrTemp() = Application.Index(Worksheets("Sheet1").Columns(6), arrTemp(), 1) ' finally we want the dates ( so far we have the row indicies obtained from Match Note. this formula has the problem that we get the results a row out of step... Its actually very convenient because if i use Cells typically, here a column then I have a nice solution
' Or
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) ' finally we want the dates ( so far we have the row indicies obtained from Match Note. this formula has the problem that we get the results a row out of step... Its actually very convenient because if i use Cells typically, here a column then I have a nice solution
Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp()
Let Range("T2").Resize(UBound(arrTemp(), 1), 1).NumberFormat = "yyyy/mm/dd" ' from macro recorder .NumberFormat = "[$-1010000]yyyy/mm/dd,@"
Stop
Range("T2").Resize(UBound(arrTemp(), 1), 1).ClearContents
' Or
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", "", 2), "#")
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) ' finally we want the dates ( so far we have the row indicies obtained from Match Note. this formula has the problem that we get the results a row out of step... Its actually very convenient because if i use Cells typically, here a column then I have a nice solution
Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp()
' Or
Range("T2").Resize(UBound(arrTemp(), 1), 1).ClearContents
Let Range("T2").Resize(UBound(Application.Index(Worksheets("Sheet1").Columns(6), Application.Index(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", "", 2), "#", -1), Evaluate("=row(1:" & UBound(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", "", 2), "#", -1)) + 1 & ")/row(1:" & UBound(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", "", 2), "#", -1)) + 1 & ")"), Evaluate("=row(1:" & UBound(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", "", 2), "#", -1)) + 1 & ")")), 1), 1), 1).Value = _
Application.Index(Worksheets("Sheet1").Columns(6), Application.Index(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", "", 2), "#", -1), Evaluate("=row(1:" & UBound(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", "", 2), "#", -1)) + 1 & ")/row(1:" & UBound(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", "", 2), "#", -1)) + 1 & ")"), Evaluate("=row(1:" & UBound(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", "", 2), "#", -1)) + 1 & ")")), 1)
End Sub
Reply With Quote
Bookmarks