Post for later use
Post for later use
Some notes from this question:
http://www.eileenslounge.com/viewtop...281312#p281312
Yasser Question.JPG
Question …
http://www.eileenslounge.com/viewtopic.php?f=30&t=36224
_____ Workbook: Extract missing dates for each person.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col A B C D E F G H I T U V 1 Name Dates Helper Check Dates Result aa Yasser Given 2 aa 2021-02-19 2021-02-19 2021-01-26 2021-01-26 2021-01-29 2021-01-29 3 aa 2021-01-26 2021-01-26 2021-01-27 2021-01-27 2021-01-30 2021-01-30 4 aa 2021-01-27 2021-01-27 2021-01-28 2021-01-28 2021-02-05 2021-02-05 5 aa 2021-01-28 2021-01-28 2021-01-29 Missing 2021-02-12 2021-02-12 6 aa 2021-01-31 2021-01-31 2021-01-30 Missing 7 aa 2021-02-01 2021-02-01 2021-01-31 2021-01-31 8 aa 2021-02-02 2021-02-02 2021-02-01 2021-02-01 9 aa 2021-02-03 2021-02-03 2021-02-02 2021-02-02 10 aa 2021-02-04 2021-02-04 2021-02-03 2021-02-03 11 aa 2021-02-06 2021-02-06 2021-02-04 2021-02-04 12 aa 2021-02-07 2021-02-07 2021-02-05 Missing 13 aa 2021-02-08 2021-02-08 2021-02-06 2021-02-06 14 aa 2021-02-09 2021-02-09 2021-02-07 2021-02-07 15 aa 2021-02-10 2021-02-10 2021-02-08 2021-02-08 16 aa 2021-02-11 2021-02-11 2021-02-09 2021-02-09 17 aa 2021-02-13 2021-02-13 2021-02-10 2021-02-10 18 aa 2021-02-14 2021-02-14 2021-02-11 2021-02-11 19 aa 2021-02-15 2021-02-15 2021-02-12 Missing 20 aa 2021-02-16 2021-02-16 2021-02-13 2021-02-13 21 aa 2021-02-17 2021-02-17 2021-02-14 2021-02-14 22 aa 2021-02-18 2021-02-18 2021-02-15 2021-02-15 23 aa 2021-02-20 2021-02-20 2021-02-16 2021-02-16 24 aa 2021-02-21 2021-02-21 2021-02-17 2021-02-17 25 aa 2021-02-22 2021-02-22 2021-02-18 2021-02-18 26 aa 2021-02-23 2021-02-23 2021-02-19 2021-02-19 27 aa 2021-02-24 2021-02-24 2021-02-20 2021-02-20 28 aa 2021-02-25 2021-02-25 2021-02-21 2021-02-21 29 bb 2021-01-27 2021-01-27 2021-02-22 2021-02-22 30 bb 2021-01-28 2021-01-28 2021-02-23 2021-02-23 31 bb 2021-01-31 2021-01-31 2021-02-24 2021-02-24 32 bb 2021-02-01 2021-02-01 2021-02-25 2021-02-25 33 bb 2021-02-03 2021-02-03
Continued from last post: Some notes from this question:
http://www.eileenslounge.com/viewtop...281312#p281312
Yasser Question.JPG https://excelfox.com/forum/showthrea...ll=1#post15418
Hans Solution. What’s he doing:
Rem 1 Make dictionary of Dictionaries2
There are two dictionary variables.
The first one contains all the unique name values from column A . So this is the unique names dictionary
We loop down to build that dictionary, and the solution is relying on a un unbroken sequential list of names, in other words no mixed up , but an order list like
Name1
Name1
Name1
Name2
Name2
..etc.
In that main loop , all the values, from column B are put in the Item ( which is itself a dictionary ) of each unique name in the unique names dictionary.
This is the clever line that does that. The line is done for each row in the data to be looked in ( column B )
Let dct1(rng1(r1, 1))(Int(rng1(r1, 2))) = 1
The 1 is arbitrary. What we are doing is like referring to ( trying to put 1 into ) the key of an item in the second dictionary that does not exist. When this is done, rather than error, the Scripting.Dictionary is programmed to make an item with that key.
The end result of all this is that we end up with a main dictionary that has a key for each unique name. The item for each name / Key has a second dictionary in it of all the Integer parts of the Date & time in column B. ( The dictionary will be seeing the basic Excel .Vaue2 of the date & time, so the Integer part will be just the date.
Here is a pseudo couple of code lines to demo that last bit
Dick1(Name1) ( 2021-02-19 ) = 1
Dick1(Name1) ( 2021-01-26 ) = 1
You see what’s going on is the following:
Dick1(Name1) will always return the same thing which is the Item in Dick1 with the Key of Name1
So Effectively those lines are pseudo
Dick2 ( 2021-02-19 ) = 1
Dick2 ( 2021-01-26 ) = 1
What those code lines try to do is put a 1 in the items of a Dick2 element that does not exist. As noted, the Scripting.Dictionary is programmed to make an item with that key rather than error if such an action is attempted.
So that is just a convenient way to make the second dictionaries – Note I said dictionaries
We end up with this:
Dick1 keys
Dick2KeysWichAreDicksInDick1Items.jpg
These lines give me that from doing a Shift F9 on any variable
Shift F9 on vTemps for Watch Window.JPG http://i.imgur.com/Ms7HmG6.jpg
Rem 2
We have an Outer loop and an inner loop in it.
__The outer loop is done once for each unique name, so for each key of the main dictionary
____The inner loop goes down the entire F column Check dates and does a write out any missing dates, that is to say dates not in the dictionary that is the item for that unique name, key of the main dictionary
Hans macro
Code:Option Explicit Sub ListMissing() ' ' Hans http://www.eileenslounge.com/viewtopic.php?p=281312#p281312 Dim vTemp1, vTemp2 ' For development and debug Dim wsh1 As Worksheet Dim wsh2 As Worksheet Dim rng1 As Variant Dim rng2 As Variant Dim m1 As Long Dim m2 As Long Dim r1 As Long Dim r2 As Long Dim r3 As Long Dim dct1 As Object Dim dcTemp2 As Object Dim n As Variant Set dct1 = CreateObject("Scripting.Dictionary") Set wsh1 = Worksheets("Sheet1") Let m1 = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row Let rng1 = wsh1.Range("A2:B" & m1).Value Rem 1 Make dictionary of Dictionaries For r1 = 1 To UBound(rng1) If Not dct1.Exists(rng1(r1, 1)) Then ' this gives us 3 elements in the dct1 that have like key aa and the item is an empty dictionary object Set dcTemp2 = CreateObject("Scripting.Dictionary") ' This effectively clears the variable used temporarily dct1.Add Key:=rng1(r1, 1), Item:=dcTemp2 End If Let dct1(rng1(r1, 1))(Int(rng1(r1, 2))) = 1 ' the 1 is arbritrary, we effectively create a Key looking like aa 2021-02-19 in the second dictionary that is the item of the unique Next r1 vTemp1 = dct1.keys() ' Dick1.JPG http://i.imgur.com/zTWYpuy.jpg vTemp2 = dct1.items() ' Dick2KeysWichAreDicksInDick1Items.jpg http://i.imgur.com/Jsd2kXS.jpg ' Let m2 = wsh1.Range("F" & wsh1.Rows.Count).End(xlUp).Row Let rng2 = wsh1.Range("F2:F" & m2).Value ' Set wsh2 = Worksheets("Sheet2Hans") wsh2.Range("A2:B" & wsh2.Rows.Count).Clear Rem 2 Go through checking for existance of an Item. For no existance , then that is missing data Let r3 = 1 ' The outer loop is done once for each unique name, so for each key of the main dictionary =========== For Each n In dct1.keys ' this and next line make it For Each of .._ Set dcTemp2 = dct1(n) ' _.. the dictionries within each item of Dick1 In other words For Each Name ' ----------------------------------------------- ' The inner loop goes down the entire F column Check dates and does a write out any missing dates, that is to say dates not in the dictionary that is the item for that unique name, key of the main dictionary For r2 = 1 To UBound(rng2) ' Going down the entire F range If Not dcTemp2.Exists(rng2(r2, 1)) Then Let r3 = r3 + 1 Let wsh2.Range("A" & r3).Value = n ' n is the key, the unique name, in the main large dictionary Let wsh2.Range("B" & r3).Value = rng2(r2, 1) ' This will be the missing entry Else End If Next r2 ' ________________________________________ Next n ' ============================================================================================== End Sub
Some notes for this question:
http://www.eileenslounge.com/viewtop...281291#p281291
For example, this bit …. using formulas like that
=IFERROR(INDEX($A$2:$C$1000,MATCH(1,($A$2:$A$1000= $I$1)*($C$2:$C$1000=F2),0),3),"Missing")
Then I manually filter by Missing and copied the results…..
That can be done in a single code line, …. _
Code:Sub BasicOneLine() ' '.... http://www.eileenslounge.com/viewtopic.php?p=281291#p281291 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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -1)) + 1 & ")")), 1) End Sub
Before
_____ Workbook: Extract missing dates for each person.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col I T U V 1 aa Yasser Given 2 2021-01-29 3 2021-01-30 4 2021-02-05 5 2021-02-12 6
After
_____ Workbook: Extract missing dates for each person.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col I T U V 1 aa Yasser Given 2 2021-01-29 2021-01-29 3 2021-01-30 2021-01-30 4 2021-02-05 2021-02-05 5 2021-02-12 2021-02-12 6
Run Sub BasicOneLine() on the uploaded file to demo those results
extended coding notes for last post
https://excelfox.com/forum/showthrea...ll=1#post15420
Code:Sub Pretty2() ' 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)")) ' 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#", "", 1, -1, vbBinaryCompare) ' This effectiveely removes the 0s data ( and its seperator ) Dim arrStrTemp() As String: Let arrStrTemp() = Split(StrTemp, "#", -1, vbBinaryCompare) ' remake the array ' 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 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 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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -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#", ""), "#", -1)) + 1 & ")")), 1) Stop ' 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#", "") Rem To get to Column N in Extract missing dates for each person.xlsm ' 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 ' The next step is to replace the errors with 0s Let arrTemp() = Evaluate("=IFERROR(IF(F2:F463=0,0,MATCH(F2:F463,C2:C463*($A$2:$A$1000=$I$1),0)),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 ' 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)")) ' 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) ' This effectiveely removes the 0s data ( and its seperator ) 'Dim arrStrTemp() As String Let arrStrTemp() = Split(StrTemp, "#", -1, vbBinaryCompare) ' remake the array ' 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(Range("C2:C463"), arrTemp(), 1) ' finally we want the dates ( so far we have the row indicies obtained from Match Let Range("N2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp() Let Range("N2").Resize(UBound(arrTemp(), 1), 1).NumberFormat = "yyyy/mm/dd" ' from macro recorder .NumberFormat = "[$-1010000]yyyy/mm/dd,@" ' Or ' Let arrTemp() = Evaluate("=If({1},IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=$I$1),0)*($A$2:$A$1000=$I$1)),ROW(F2:F463),0))") 'let worksheets("Sheet2").range 'v = Join(v, "#") ' https://www.vbarchiv.net/commands/cmd_filter.html ' ' 'v = Application.Index(Range("C2:C463"), Evaluate("=If({1},MATCH(F2:F463,C2:C463*($A$2:$A$1000=$I$1),0)*($A$2:$A$1000=$I$1))"), 1) ' ' 'v = Application.Index(v, Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")) 'v = Evaluate("=IFERROR(INDEX($A$2:$C$1000,MATCH(1,($A$2:$A$1000=$I$1)*($C$2:$C$1000=" & r.Address & "),0),3),""Missing"")") ' End Sub Sub BasicOneLine() ' '.... http://www.eileenslounge.com/viewtopic.php?p=281291#p281291
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
We can use the basic idea above to make a function idea to do the sameCode: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
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
In support of these Threads and posts
https://excelfox.com/forum/showthrea...ll=1#post15421
http://www.eileenslounge.com/viewtopic.php?f=30&t=36224
A problem arose with testing with bb
_____ Workbook: Extract missing dates for each person bb.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col T U V W X Y Z 1 Yasser Given Hans Results Indicies 2 2021-01-26 2021-01-29 2021-01-29 2 3 2021-01-30 2021-01-30 0 4 2021-02-05 2021-02-05 0 5 2021-01-29 2021-02-12 2021-02-12 5 6 2021-01-30 2021-01-26 2021-01-26 6 7 2021-01-29 2021-01-29 0 8 2021-01-30 2021-01-30 0 9 2021-02-02 2021-02-02 2021-02-02 9 10 2021-02-05 0 11 2021-02-12 0 12 2021-02-05 2021-02-05 12 13 2021-02-16 0 14 2021-02-19 0 15 2021-02-25 0 16 0 17 0 18 0 19 2021-02-12 2021-02-12 19 20 2021-02-13 20 21 0 22 2021-02-15 22 23 2021-02-16 2021-02-16 23 24 0 25 0 26 2021-02-19 2021-02-19 26 27 0 28 0 29 0 30 0 31 0 32 2021-02-25 2021-02-25 32 33 2021-01-29 0
If you examine above my ( wrong) results in column T against Hans results in column V and
then look at the Debug / Immediate window info below for
before ( http://i.imgur.com/M3laahV.jpg )
and
after ( http://i.imgur.com/RUPIWIg.jpg ), where I take out the unwanted data from a text string , .._
_...then I can see the problem and where its coming from:Code:? strtemp 2#0#0#5#6#0#0#9#0#0#12#0#0#0#0#0#0#19#20#0#22#23#0#0#26#0#0#0#0#0#32#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 ? strtemp 2#5#6#9#12#19#222#23#26#32
The problem is that I chose to remove the unwanted data
_ first by removing all #0 - that works fine, no problem with that as I am not expecting any real data starting with a 0
_ second I allow for the case of unwanted data at the start by removing all 0# - this can cause problems as it has in this example – It has resulted for example in this
#20#0#22
becoming this
#20#22
And then when after , (or previously) the 0# is removed/ was removed, the final result is
#222
So I loose the valid data of 20 and 22 and get a wrong data of 222 ( and in the test data, indicial 222 matches to an empty cell )
The final outcome is I loose two final date values and gain an extra unwanted empty ( nonsense date zero value ) date
There are thousands of easy ways to solve this problem , with various If Then ways. But these will “interrupt the flow” as it were, leading to inefficiency and prevent me building my final one line code way.
This first element problem is one I often refer to as an awkward bollock
Variations of this come up a lot. Often an efficient cure to this awkward bollock is to include an extra separator at the start. This wont quite for us in the case of this data, but almost.
The following variation seems OK
Consider these two lines, where the awkward bollock is dealt with second
Solution:Code:' 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", "", 2, -1, vbBinaryCompare): StrTemp = Replace(StrTemp, "0#", "", 1, -1, vbBinaryCompare) ' This effectively removes the 0s data ( and its seperator )
I add some arbitrary character at the start
StrTemp = "_" & Join(arrTemp(), "#")
That wont add much extra overhead
Now deal with the awkward bollock first
StrTemp = Replace(StrTemp, "_0#", "_" ………..
That has done no extra work, just done an existing step a bit differently
So far nothing so clever. The next part allows us to do no, or little, extra work by taking advantage of a little known extra argument of the Replace
The forth (optional) argument of Replace lets us say at which character point in the original we start our returned string. That may confuse, so let me say that again with an example..
I have this xy-z-2 and I want this yz2
Most people would think they need
either
_ two Replaces , one to take out – and the other to take out x
or
_ a Replace to take out – and then some other process or function to take out the first character.
But if we choose 2 in our forth argument of the Replace that takes out the - , then our returned string will effectively have the first character removed.
That seems to solve the problemCode:' 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 )
strTempAfterProblemSolved.JPG
Full macro in next post
Full macro for last post
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
I am not quite sure what got in my brain in the last post. With hind site most of what I said and done is crap. But maybe later I will twig to what was going on.
I will start again…. Or rather pick it up where I went off course…._ I have …_
_.... an awkward bollock
Variations of this come up a lot. Often an efficient cure to this awkward bollock is to include an extra separator at the start.
The general solution is fine. After adding a separator, #, at the start, I remove all #0
All is well and then I only need to get rid finally of a single # I don’t need at the start.
For that last thing, Mid(StrTemp,2) would do. So would a second Replace in this form Replace(StrTemp, "#", "", 1, 1…. Or Replace(StrTemp, "#", "", , 1….
In the Replace.. we are using the 5th (optional ) argument to restrict us to removing a single # and the convention is to start from the left so that will hit on the first.
In this complete version I use the Mid(StrTemp,2) way
Code:Option Explicit Sub Pretty3bbaa() ' Dim arrTemp() As Variant Rem To get the results in column T ( same as Yassers or Hans Results ' Ths first forumula gives 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 ( 2 lines commented out to prevent the shortened line messing up ) Dim StrTemp As String: Let StrTemp = "#" & Join(arrTemp(), "#") ' Convert the array to a string with a # in between each data. The extra # allows us to remove all 0 entries via removing all #0 Without this we might get one left at the start ' Let StrTemp = Replace(StrTemp, "#0", "", 1, -1, vbBinaryCompare) ' This effectiveely removes the 0s data ( and its seperator ) ' Let StrTemp = Mid(StrTemp, 2) ' Because I omit the third optional ( length ) argument I get all the remaing string after the first one. This effectively takes off the extra # which I don't need Dim arrStrTemp() As String: Let arrStrTemp() = Split(StrTemp, "#", -1, vbBinaryCompare) ' remake the array ' Or , Let arrStrTemp() = Split(Mid(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", ""), 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 End Sub Sub SlightlySanerVersion() Dim arrStrTemp() As String: Let arrStrTemp() = Split(Mid(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", ""), 2), "#") 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" ' "aa" Let arrStrTemp() = Split(Mid(Replace("#" & Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=" & """" & UnicNm & """" & "),0)*($A$2:$A$1000=" & """" & UnicNm & """" & ")),ROW(F2:F463),0)"), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")), "#"), "#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) Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp() End Sub
I can sanitise the last version a bit and come up with a simple function to get you an array of your missings, where the function takes the unique name, ( the unique name in the test data is the things like aa bb cc etc. )
Code:Sub SlightlySanerVersion() Dim arrStrTemp() As String: Let arrStrTemp() = Split(Mid(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", ""), 2), "#") 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" ' "aa" Let arrStrTemp() = Split(Mid(Replace("#" & Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=" & """" & UnicNm & """" & "),0)*($A$2:$A$1000=" & """" & UnicNm & """" & ")),ROW(F2:F463),0)"), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")), "#"), "#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) Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp() End Sub Sub UseNotSoInsaneFunction() Dim arrTemp() As Variant Let arrTemp() = NotSoInsane("bb") ' Columns("T:T").ClearContents ' Range("T2").Resize(UBound(arrTemp(), 1), 1).ClearContents Let Range("T2").Resize(UBound(arrTemp(), 1), 1).Value = arrTemp() Let Range("T2").Resize(UBound(arrTemp(), 1), 1).NumberFormat = "yyyy/mm/dd" End Sub Function NotSoInsane(ByVal Nme As String) As Variant Dim arrStrTemp() As String: Let arrStrTemp() = Split(Mid(Replace("#" & Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F463,C2:C463*($A$2:$A$1000=" & """" & Nme & """" & "),0)*($A$2:$A$1000=" & """" & Nme & """" & ")),ROW(F2:F463),0)"), Evaluate("=column(A:QT)"), Evaluate("=column(A:QT)/column(A:QT)")), "#"), "#0", ""), 2), "#") 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 '
Posting Permissions
Reply With Quote
Bookmarks