-
-
In support of this post
http://www.eileenslounge.com/viewtop...281164#p281164
Code:
Sub On___Then____() ' http://www.eileenslounge.com/viewtopic.php?p=281164#p281164
' Going nowhere the first ____ evaluates to a number in range 0 or 2 , 3, 4 ..... 255 so I don't GoTo
On 0.2 GoTo NeverBeHere
On Err GoTo NeverBeHere
On TwitTwo GoTo NeverBeHere
On Nmber(255) GoTo NeverBeHere
On -0.5 GoTo NeverBeHere
On 255.49999 GoTo NeverBeHere
' Going somewhere the first ____ evaluates to 1 so I GoTo
On 1 GoTo 10
MsgBox prompt:="I am never here. You will never see this"
10 On 1.49999 GoTo 20
MsgBox prompt:="I am never here. You will never see this"
20 On Nmber(0.5001) GoTo 30
MsgBox prompt:="I am never here. You will never see this"
30 Exit Sub
'
NeverBeHere:
' I will never be here
MsgBox prompt:="I am never here. You will never see this"
End Sub
Function TwitTwo() As Double
Let TwitTwo = 2.1
End Function
Function Nmber(ByVal No As Double) As Double
Let Nmber = No
End Function
-
-
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
http://i.imgur.com/Ot6o46f.jpg
_____ Workbook: Extract missing dates for each person.xlsm ( Using Excel 2007 32 bit )
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 |
|
|
|
|
|
|
|
|
|
Worksheet: Sheet1
-
1 Attachment(s)
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
http://i.imgur.com/zTWYpuy.jpg
Dick2KeysWichAreDicksInDick1Items.jpg
http://i.imgur.com/Jsd2kXS.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
-
1 Attachment(s)
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 )
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 |
|
|
|
|
Worksheet: Sheet1
After
_____ Workbook: Extract missing dates for each person.xlsm ( Using Excel 2007 32 bit )
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 |
|
|
|
|
Worksheet: Sheet1
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
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
-
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 )
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 |
Worksheet: Sheet1
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 , .._
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
_...then I can see the problem and where its coming from:
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
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 )
Solution:
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.
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#", "_", 1, 1, vbBinaryCompare): StrTemp = Replace(StrTemp, "#0", "", 2, -1, vbBinaryCompare) ' This effectiveely removes the 0s data ( and its seperator )
That seems to solve the problem
strTempAfterProblemSolved.JPG
http://i.imgur.com/Dgu8NE1.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