Appendix Thread. App Index Rws() Clms() Majic code line Codings for other Threads, Tables etc.)

**DocAElstein** · 02-09-2021, 10:53 PM

Macro for last post

Code:

Option Explicit
Sub StartOffvbadumbarse()
Rem 1 Worksheets info
Dim WsIn As Worksheet, WsOut As Worksheet
 Set WsIn = ThisWorkbook.Worksheets.Item(1): Set WsOut = ThisWorkbook.Worksheets.Item(2)
Dim arrIn() As Variant: Let arrIn() = WsIn.Range("B1:F5").Value2
Rem 2
'2b
Dim Clm As Long
    For Clm = 1 To 5 Step 1
        If arrIn(1, Clm) = "" Then
        ' Nothing to do for no header
        Else
        Dim Itms As String: Let Itms = arrIn(1, Clm)
        Dim RwDta As Long
            For RwDta = 2 To 5 Step 1
            Dim strFndWd As String
                If arrIn(RwDta, Clm) = "" Then
                ' no data
                Else
                    If InStr(1, arrIn(RwDta, Clm), "|", vbBinaryCompare) > 0 Then ' we must have two or more datas seperatied by a  |
                    Dim CelDts As Long
                        For CelDts = 0 To UBound(Split(arrIn(RwDta, Clm), "|", -1, vbBinaryCompare))
                         Let strFndWd = strFndWd & Split(arrIn(RwDta, Clm), "|", -1, vbBinaryCompare)(CelDts) & vbCr & vbLf
                        Next CelDts
                    Else ' case single data
                     Let strFndWd = strFndWd & arrIn(RwDta, Clm) & vbCr & vbLf  ' effectively a single row is added for this data
                    End If
                End If
            Next RwDta
        '2e we have been through the data, so time to see what we got and fill our two strings appropriately
        Dim strOutA As String, strOutB As String
            If strFndWd = "" Then ' case we had no data
             Let strFndWd = strFndWd & vbCr & vbLf ' effectively adds an empty row
             Let strOutA = strOutA & Itms & vbCr & vbLf ' a single row with header
            Else ' we have data, so need do add some rows to strOutA ( strOutB effecively has all the rows determined by the number of  vbCr & vbLf   added
            Dim RwCnt As Long: Let RwCnt = UBound(Split(strFndWd, vbCr & vbLf, -1, vbBinaryCompare)) + 1 - 1 ' The number of  vbCr & vbLf  gives us the number rows
                For CelDts = 1 To RwCnt
                 Let strOutA = strOutA & Itms & vbCr & vbLf
                Next CelDts
            End If
        End If
     Let strOutB = strOutB & strFndWd
     Let strFndWd = ""
    Next Clm
' I can view my data in a message box or in the immediate window
 MsgBox Prompt:=strOutA: Debug.Print strOutA
 MsgBox Prompt:=strOutB: Debug.Print strOutB

Rem 3 outout
Dim arrOutA() As String: Let arrOutA() = Split(strOutA, vbCr & vbLf, -1, vbBinaryCompare) '  Excel has the convention of taking a  1D  array as being "horizontal" for spreadsheet purposes, so will consider it as a row of data values if applied to a worksheet range
Dim arrOutB() As String: Let arrOutB() = Split(strOutB, vbCr & vbLf, -1, vbBinaryCompare)
' Let WsOut.Range("A2").Resize(UBound(arrOutA()), 1).Value = Application.Transpose(arrOutA())
 Let WsOut.Range("A2").Resize(UBound(arrOutA()), 1).Value = Application.Index(arrOutA(), Evaluate("=row(1:" & UBound(arrOutA()) & ")/row(1:" & UBound(arrOutA()) & ")"), Evaluate("=row(1:" & UBound(arrOutA()) & ")"))
' Let WsOut.Range("B2").Resize(UBound(arrOutB()), 1).Value = Application.Transpose(arrOutB())
 Let WsOut.Range("B2").Resize(UBound(arrOutB()), 1).Value = Application.Index(arrOutB(), Evaluate("=row(1:" & UBound(arrOutB()) & ")/row(1:" & UBound(arrOutB()) & ")"), Evaluate("=row(1:" & UBound(arrOutB()) & ")"))
End Sub

**DocAElstein** · 02-27-2021, 06:18 PM

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

**DocAElstein** · 03-05-2021, 05:17 PM

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 )

_Row\^Col	A	B	C	F	G	I	T	U
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