I have done another couple of versions, just out of interest.
I have also
adjusted the code to be the same last row, but in these two versions the last row is not hard coded. I am using the last row of data. So that is found dynamically.
Because we use the same last row, I can simplify a few things.
The difference between the two new versions is that
_ one uses the conventional
Transpose function to do a couple of transposing.
_ In the other one, the same transposing is done in that strange
Index function way that I personally like to do.
The full workings are here:
https://excelfox.com/forum/showthread.p ... #post15434
https://excelfox.com/forum/showthread.p ... #post15436
I have modified those full workings to come up with two new functions. ( The first macro needs also one extra Column Letter function )
To help avoid confusion, I will post each macro in a separate post, with an uploaded file , which once again is based on your original data.
In both workbooks is also a version of Hans macro which you can see gives the same results as mine.
( The macros do not use the helper column this time. They use Column B )
Alan
_.___________________________________
P.S. Just as an example of what the next two macros are based on ,
This is the one code line which will get you dynamically the list, for the missing dates, based on the name in cell I1 ,using on your original data.
Transpose Function Way
Code: Select all
Sub SingleLinePretty3dTranspose() ' Activate Sheet1 to try this
Dim M As Long: Let M = Worksheets("Sheet1").Range("A" & Worksheets("Sheet1").Rows.Count & "").End(xlUp).Row
Let Range("T2").Resize(UBound(Application.Index(Worksheets("Sheet1").Columns(6), Application.Transpose(Split(Mid(Replace("#" & Join(Application.Transpose(Evaluate("=IF(ISERROR(MATCH(F2:F" & M & ",Int(B2:B" & M & ")*(A2:A" & M & "=I1),0)*(A2:A" & M & "=I1)),ROW(F2:F" & M & "),0)")), "#"), "#0", ""), 2), "#")), 1), 1), 1).Value = Application.Index(Worksheets("Sheet1").Columns(6), Application.Transpose(Split(Mid(Replace("#" & Join(Application.Transpose(Evaluate("=IF(ISERROR(MATCH(F2:F" & M & ",Int(B2:B" & M & ")*(A2:A" & M & "=I1),0)*(A2:A" & M & "=I1)),ROW(F2:F" & M & "),0)")), "#"), "#0", ""), 2), "#")), 1)
End Sub
Index Function Way
Here below is the equivalent for the way using the
Index to do the transposing
Code: Select all
Sub ShortPretty3d() ' Activate Sheet1 to try this
Dim M As Long: Let M = Worksheets("Sheet1").Range("A" & Worksheets("Sheet1").Rows.Count & "").End(xlUp).Row
Dim arrStrTemp() As String: Let arrStrTemp() = Split(Mid(Replace("#" & Join(Application.Index(Evaluate("=IF(ISERROR(MATCH(F2:F" & M & ",Int(B2:B" & M & ")*(A2:A" & M & "=I1),0)*(A2:A" & M & "=I1)),ROW(F2:F" & M & "),0)"), Evaluate("=column(A:" & CL(M - 1) & ")"), Evaluate("=column(A:" & CL(M - 1) & ")/column(A:" & CL(M - 1) & ")")), "#"), "#0", ""), 2), "#")
Let Range("T2").Resize(UBound(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), 1), 1).Value = 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)
End Sub
The
Function Missings( ) is based on these code lines.
That function is the main thing that my alternatives are based on.
They are basically similar to the right hand side of the long code lines in those above code snippets, since that returms us a ( vertical ) arrray which we can paste into a soreadsheet, ( or as a prelude to that we have an array,
arrStrTemp() , which contains the row number of the required rows from the
Check Dates list which correspond to the missing dates )
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also