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

**DocAElstein** · 01-04-2020, 01:30 AM

Coding for this Thread post
http://www.excelfox.com/forum/showth...ll=1#post11827

Code:

Sub MakeFormulas4() '  http://www.excelfox.com/forum/showthread.php/2390-Apply-Vlookup-formula-in-all-the-available-sheets-in-a-workbook?p=11827&viewfull=1#post11827
Rem 1 '  Workbooks info
' 1a This months book, this workbook. It is the outout book for the current month
Dim ThisMonthsLatestBook As Workbook, LisWbName As String
 Set ThisMonthsLatestBook = ThisWorkbook ' ActiveWorkbook
 Let LisWbName = ThisMonthsLatestBook.Name
'    If InStr(7, LisWbName, Format(Now(), "MMM"), vbTextCompare) = 0 Then MsgBox Prompt:="This workbook is not for " & Format(Now(), "MMMM"): Exit Sub
'Dim BookN As Long
' Let BookN = Mid(LisWbName, 5, InStr(5, LisWbName, "_", vbBinaryCompare) - 5)
' 1b Last months book
Dim strDteLisBk As String, DteLisBk As Date
 Let strDteLisBk = Mid(LisWbName, 32, 8)
Dim LooksLikeADate As String: Let LooksLikeADate = Right(strDteLisBk, 2) & "." & Mid(strDteLisBk, 5, 2) & "." & Left(strDteLisBk, 4)
 Let DteLisBk = CDate(LooksLikeADate) '  31.12.2019  Looks like a date

Dim sourceBookName As String
' Let sourceBookName = "Book" & BookN - 1 & "_" & Format(DateAdd("m", -1, Now()), "MMM YYYY") & ".xlsm"
  Let sourceBookName = "MSCI Equity Index Constituents " & Format(DateAdd("m", -1, DteLisBk), "YYYYMMDD") & ".xlsm"
Dim sourceBook As Workbook
 Set sourceBook = Workbooks.Open(ThisWorkbook.Path & "\" & sourceBookName)
Rem 2  Make records worksheet                                                                  Sub MakeWorkSheetIfNotThere()
'Dim Wb As Workbook '                                   ' ' Dim:  ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense )                     '
' Set Wb = ActiveWorkbook '  '                            Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...         Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191                                '
     If Not Evaluate("=ISREF(" & "'" & "Records" & "'!Z78)") Then '   ( the '  are not important here, but in general allow for a space in the worksheet name like  "My Records"
     ThisMonthsLatestBook.Worksheets.Add After:=ThisMonthsLatestBook.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
    Dim wsRcds As Worksheet '
     Set wsRcds = ThisMonthsLatestBook.Worksheets.Item(ThisMonthsLatestBook.Worksheets.Count)        'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want...    Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191            ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
     wsRcds.Activate: wsRcds.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
     Let wsRcds.Name = "Records"
    Else ' The worksheet is already there , so I just need to set my variable to point to it
     Set wsRcds = ThisWorkbook.Worksheets("Records")
    End If
'                                                                                               End Sub
Rem 3 looping through worksheets
Dim C As Long, I As Long
'C = ActiveWorkbook.Worksheets.Count
 'Let C = ThisWorkbook.Worksheets.Count
 Let C = ThisMonthsLatestBook.Worksheets.Count - 1  '   -1 since last worksheet is records worksheet
    'For I = 1 To C
'Application.ScreenUpdating = True
    For I = 1 To C   '   Sheet1  , Sheet2   , Sheet3 .......
    'what are  our worksheets?                         I   =  1        ,       2 ,      3    ..........
    Dim sourceSheet As Worksheet
     Set sourceSheet = sourceBook.Worksheets.Item(I) '     ("Sheet1")  , Sheet2   , Sheet3 ........
    Dim outputSheet As Worksheet
     Set outputSheet = ThisWorkbook.Worksheets.Item(I) ' ("Sheet1")    , Sheet2   , Sheet3 ........
       
        'Determine last row of source
        With sourceSheet
        Dim SourceLastRow As Long
         SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
        With outputSheet
        'Determine last row in col P
        Dim OutputLastRow As Long
         OutputLastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
        End With
        'Apply our formula in records worksheet
        With Worksheets("Records")
         Let .Cells.Item(1, I).Value = sourceSheet.Name   '  Header in column as worksheet name
         '.Range("Q2:Q" & OutputLastRow).Formula = "=VLOOKUP($A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$P$" & SourceLastRow & ",3,0)"
         .Range("" & CL(I) & "2:" & CL(I) & "" & OutputLastRow).Value = "=VLOOKUP(" & outputSheet.Name & "!$A2,'" & sourceBook.Path & "\" & "[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$P$" & SourceLastRow & ",3,0)"
'        .Range("" & CL(I) & "2:" & CL(I) & "" & OutputLastRow).Value = .Range("" & CL(I) & "2:" & CL(I) & "" & OutputLastRow).Value
        End With
     'MsgBox ActiveWorkbook.Worksheets(I).Name
     MsgBox ActiveWorkbook.Worksheets.Item(I).Name
    Next I
'Next P
Rem 4
Dim cel As Range
    With Worksheets("Records").UsedRange
        For Each cel In .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
            If IsError(cel.Value) Then
            '
            Else
                If cel.Value < 3 Then
                 cel.Font.Color = vbRed
                Else
                 cel.Font.Color = vbGreen
                End If
            End If
        Next cel
    End With
    
'Close the source workbook, don't save any changes
 sourceBook.Close False
' Application.ScreenUpdating = True
End Sub

**DocAElstein** · 01-07-2020, 05:50 PM

Coding in support of these Thread posts
http://www.excelfox.com/forum/showth...ll=1#post11569
http://www.excelfox.com/forum/showth...ll=1#post11672

Code:


Sub ipconfigall_routeprint(Optional ByVal Msg As String) '
Rem 1 ipconfig /all
 Shell "cmd.exe /c ""ipconfig /all > """ & ThisWorkbook.Path & "\ipconfig__all.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig__all.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, -1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, -1, vbBinaryCompare)
' add any extra info to string
Dim PublicIP As String: Call PubicIP(PublicIP)
  Let strIPcon = "ipconfig /all   route print" & Msg & vbCr & vbLf & ComputerName & vbCr & vbLf & GetIpAddrTable & vbCr & vbLf & PublicIP & vbCr & vbLf & vbCr & vbLf & """" & Format(Now, "DD MMM YYYY") & " " & vbLf & " " & Format(Now, "hh mm ss") & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & strIPcon        ' vbLf is recognised as a new line within an Excel"
' String content check
' Call WtchaGot(strIPcon)
' put the text in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObject.SetText strIPcon: objDataObject.PutInClipboard

' Excel Worksheet
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim Clm As Range, NxtClm As Long
 Set Clm = Ws.Cells.Find(What:="*", After:=Ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Clm Is Nothing Then
     Let NxtClm = 2
    Else
     Let NxtClm = Clm.Column + 1
    End If
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(1, NxtClm)
' Ws.Columns.AutoFit: Ws.Rows.AutoFit

Rem 2 route print
 Shell "cmd.exe /c ""route print > """ & ThisWorkbook.Path & "\route_print.txt"""""
' Get the entire text file as a string
 Let FileNum = FreeFile(1) '              ' The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use.  The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511.   https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function  . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Dim strrouteprint As String
 Let PathAndFileName = ThisWorkbook.Path & "\route_print.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strrouteprint = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strrouteprint
  Close #FileNum
' Tidy the string
 Let strrouteprint = Replace(strrouteprint, vbCr & vbCr, vbCr, 1, -1, vbBinaryCompare)
 Let strrouteprint = Replace(strrouteprint, vbTab, "   ", 1, -1, vbBinaryCompare)
' put the text in the clipboard
objDataObject.SetText strrouteprint: objDataObject.PutInClipboard
' Excel Worksheet
Dim Lr As Long: Let Lr = Ws.Cells(Ws.Rows.Count, NxtClm).End(xlUp).Row
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(Lr + 30, NxtClm)
 Ws.Columns.AutoFit: Ws.Rows.AutoFit
 ActiveWindow.Panes(2).Activate
 Ws.Cells.Item(1, NxtClm).Select
End Sub
'

**DocAElstein** · 01-10-2020, 12:31 AM

In support of this Thread
http://www.excelfox.com/forum/showthread.php/2402-Extract-Multiple-Rows-into-a-Limited-Template-based-on-Multiple-Criterias
http://www.excelfox.com/forum/showth...iple-Criterias

Summary worksheet, before

_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C
1	Voucher	Date	Link
2			Go To Sheet
3			Go To Sheet
4

Worksheet: Summary

**DocAElstein** · 01-10-2020, 12:31 AM

In support of this Thread
http://www.excelfox.com/forum/showthread.php/2402-Extract-Multiple-Rows-into-a-Limited-Template-based-on-Multiple-Criterias
http://www.excelfox.com/forum/showth...iple-Criterias

_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

01.01.2020_99909900 - A

01.01.2020_88888888 - F

01.01.2020_88888886 - D

01.01.2020_88888887 - E

02.01.2020_99909900 - A

03.01.2020_99909900 - A

04.01.2020_88888888 - F

05.01.2020_88888888 - F

06.01.2020_88888888 - F

07.01.2020_88888888 - F

08.01.2020_88888888 - F

09.01.2020_88888888 - F

10.01.2020_99909900 - A

11.01.2020_99909900 - A

12.01.2020_99909900 - A

13.01.2020_99909900 - A

14.01.2020_99909900 - A

15.01.2020_99909900 - A

**DocAElstein** · 01-10-2020, 12:31 AM

In support of this Thread
http://www.excelfox.com/forum/showthread.php/2402-Extract-Multiple-Rows-into-a-Limited-Template-based-on-Multiple-Criterias
http://www.excelfox.com/forum/showth...iple-Criterias

_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item D	LLL000	1	131	131	1E+08	A	1	131	131	01.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item D	LLL000	1	131	131	1E+08	A	1	131	131	01.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item D	LLL000	1	131	131	1E+08	A	1	131	131	01.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item D	LLL000	1	131	131	1E+08	A	1	131	131	01.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item B	LLL000	1	131	131	8.9E+07	F	1	131	131	01.01.2020_88888888 - F
01.01.2020	5	Item C	LLL000	5	550	2750	8.9E+07	F	5	550	2750	01.01.2020_88888888 - F
01.01.2020	1	Item D	ABC123	1	2000	2000	8.9E+07	D	1	2000	2000	01.01.2020_88888886 - D
01.01.2020	4	Item D	LLL000	1	131	131	8.9E+07	E	1	131	131	01.01.2020_88888887 - E
01.01.2020	5	Item E	LLL000	5	550	2750	8.9E+07	F	5	550	2750	01.01.2020_88888888 - F
01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item D	LLL000	1	131	131	1E+08	A	1	131	131	01.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
01.01.2020	1	Item A	ABC123	1	2000	2000	1E+08	A	1	2000	2000	01.01.2020_99909900 - A
01.01.2020	4	Item D	LLL000	1	131	131	1E+08	A	1	131	131	01.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
02.01.2020	2	Item B	ABC122	1	3500	3500	1E+08	A	1	3500	3500	02.01.2020_99909900 - A
03.01.2020	3	Item C	LLL000	4	10.4	41.6	1E+08	A	4	10.4	41.6	03.01.2020_99909900 - A
04.01.2020	4	Item D	LLL001	1	131	131	8.9E+07	F	1	131	131	04.01.2020_88888888 - F
05.01.2020	5	Item E	ABC999	8	550	4400	8.9E+07	F	8	550	4400	05.01.2020_88888888 - F
06.01.2020	6	Item F	ABC999	1	2500	2500	8.9E+07	F	1	2500	2500	06.01.2020_88888888 - F
07.01.2020	7	Item G	LLL001	1	2500	2500	8.9E+07	F	1	2500	2500	07.01.2020_88888888 - F
08.01.2020	8	Item H	LLL001	1	2250	2250	8.9E+07	F	1	2250	2250	08.01.2020_88888888 - F
09.01.2020	4	Item D	ABC123	1	2250	2250	8.9E+07	F	1	2250	2250	09.01.2020_88888888 - F
10.01.2020	5	Item E	ABC122	1	2250	2250	1E+08	A	1	2250	2250	10.01.2020_99909900 - A
11.01.2020	11	Item K	ABC122	1	600	600	1E+08	A	1	600	600	11.01.2020_99909900 - A
12.01.2020	12	Item L	ABC123	1	4992	4992	1E+08	A	1	4992	4992	12.01.2020_99909900 - A
13.01.2020	13	Item M	ABC122	1	10	10	1E+08	A	1	10	10	13.01.2020_99909900 - A
14.01.2020	6	Item F	LLL000	1	2731	2731	1E+08	A	1	2731	2731	14.01.2020_99909900 - A
15.01.2020	7	Item G	ABC122	1	85000	85000	1E+08	A	1	85000	85000	15.01.2020_99909900 - A
01.01.2020	5	Item E	LLL000	5	550	2750	1E+08	A	5	550	2750	01.01.2020_99909900 - A
02.01.2020	2	Item B	ABC122	1	3500	3500	1E+08	A	1	3500	3500	02.01.2020_99909900 - A
03.01.2020	3	Item C	LLL000	4	10.4	41.6	1E+08	A	4	10.4	41.6	03.01.2020_99909900 - A
04.01.2020	4	Item D	LLL001	1	131	131	8.9E+07	F	1	131	131	04.01.2020_88888888 - F
05.01.2020	5	Item E	ABC999	8	550	4400	8.9E+07	F	8	550	4400	05.01.2020_88888888 - F
06.01.2020	6	Item F	ABC999	1	2500	2500	8.9E+07	F	1	2500	2500	06.01.2020_88888888 - F
07.01.2020	7	Item G	LLL001	1	2500	2500	8.9E+07	F	1	2500	2500	07.01.2020_88888888 - F
08.01.2020	8	Item H	LLL001	1	2250	2250	8.9E+07	F	1	2250	2250	08.01.2020_88888888 - F
09.01.2020	4	Item D	ABC123	1	2250	2250	8.9E+07	F	1	2250	2250	09.01.2020_88888888 - F
10.01.2020	5	Item E	ABC122	1	2250	2250	1E+08	A	1	2250	2250	10.01.2020_99909900 - A
11.01.2020	11	Item K	ABC122	1	600	600	1E+08	A	1	600	600	11.01.2020_99909900 - A
12.01.2020	12	Item L	ABC123	1	4992	4992	1E+08	A	1	4992	4992	12.01.2020_99909900 - A
13.01.2020	13	Item M	ABC122	1	10	10	1E+08	A	1	10	10	13.01.2020_99909900 - A

Worksheet: arrAllDts

**DocAElstein** · 01-10-2020, 12:31 AM

In support of this Thread
http://www.excelfox.com/forum/showthread.php/2402-Extract-Multiple-Rows-into-a-Limited-Template-based-on-Multiple-Criterias
http://www.excelfox.com/forum/showth...iple-Criterias

_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

4

5

6

7

8

9

10

11

12

13

14

15

16

22

23

24

25

26

27

42

Worksheet: arrRws

_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

4
5
6
7
8
9
10
11
12
13
14
15
16
22
23
24
25
26
27
42

Worksheet: arrRwsT

**DocAElstein** · 01-10-2020, 12:42 AM

In support of this Thread
http://www.excelfox.com/forum/showthread.php/2402-Extract-Multiple-Rows-into-a-Limited-Template-based-on-Multiple-Criterias
http://www.excelfox.com/forum/showth...iple-Criterias

Code:

Option Explicit
Sub DoItForADay()
Rem 1 Worksheets info
Dim WsTp As Worksheet, WsDta As Worksheet, WsSmry As Worksheet
 Set WsTp = ThisWorkbook.Worksheets("Template"): Set WsDta = ThisWorkbook.Worksheets("Datadump"): Set WsSmry = ThisWorkbook.Worksheets("Summary")
Rem 2 The days and source list
' 2a) Put all info in an array
Dim LrDta As Long: Let LrDta = WsDta.Range("A" & WsDta.Rows.Count & "").End(xlUp).Row
Dim arrAllDts() As Variant           '  In the naxt line, the  .Value  Property ( method ) , is used to return in one go all  Values  in the range.  They are returned as a field, ( array ) of values in  held in  Variant  type  elements.  So we must use Variant for the  Dim ing  of the type of our Elements, or else the next code line will error , with a  Mismatch error
 Let arrAllDts = WsDta.Range("A4:M" & LrDta & "").Value '  I am adding  column M  for my own amusement
' 2b)

' 2c) make an array with all unique identifier for each voucher
Dim Cnt As Long
    For Cnt = 1 To UBound(arrAllDts(), 1) ' Looping effectively from forth row until last row in  Datadump
Dim Idt As String
     Let Idt = arrAllDts(Cnt, 1) & "_" & arrAllDts(Cnt, 8) & " - " & arrAllDts(Cnt, 9) '  I am adding a  "_"  to in between the   date   and   source info  : Later I can split the   unique identifiers  string by this  "_"  in order to get the date and souce info
     Let arrAllDts(Cnt, 13) = Idt
    Dim strDtsSrc As String
        If InStr(1, strDtsSrc, Idt, vbBinaryCompare) = 0 Then
         Let strDtsSrc = strDtsSrc & Idt & "###"
        Else
        ' case we already have the date in our string,  strDts
        End If
    Next Cnt
 Let strDtsSrc = Left(strDtsSrc, (Len(strDtsSrc) - 3)) '  take off the last space  "###"  which we do not need
 'Debug.Print strDtsSrc
' 2d)
Dim arrUnicDtsSrc() As String
 Let arrUnicDtsSrc() = Split(strDtsSrc, "###", -1)
 Let Worksheets("arrUnicDtsSrc").Range("A1").Resize(1, (UBound(arrUnicDtsSrc()) + 1)).Value = arrUnicDtsSrc()      '    arrUnicDtsSrc().jpg  --- https://imgur.com/QX1bJMB
 Worksheets("arrUnicDtsSrc").Columns.AutoFit
 Let Worksheets("arrAllDts").Range("A4:M" & LrDta & "").Value = arrAllDts()
 ' The next code line can be removed to get all the 19 worksheets
 ReDim arrUnicDtsSrc(0 To 0): Let arrUnicDtsSrc(0) = "01.01.2020_99909900 - A" ' ***** I am limiting it to the first unique identifier, ( 01.01.2020_99909900 - A ) just for demo purposes. If you remove this line,  then you will see that all dates and sources  will be considered
Rem 3                               ' === Main Outer loop ============================================================
Dim Stear As Variant    '   For Each  unique identifier  . In VBA,
    For Each Stear In arrUnicDtsSrc() ' Doing stuff For Each  unique identifier
    '3a) work out how many rows and which row indicies with the current unique identifier
    Dim DteSrcRwCnt As Long
        For Cnt = 1 To UBound(arrAllDts(), 1) ' ----------------------Going through all data rows
         If arrAllDts(Cnt, 13) = CStr(Stear) Then ' I am looking for rows in the main datadump that have the current unique identifier
        '3a)(i) counting rows
                                                                           ' Debug.Print Cnt + 3 & " " & arrAllDts(Cnt, 13)
          Let DteSrcRwCnt = DteSrcRwCnt + 1  '  counting the rows for the current unique identifier
         '3a)(ii) get the (row) indicies for the current unique identifier. Later i need the row number of all the rows corresponding to the current unique identifier
         Dim strRws As String
          Let strRws = strRws & Cnt + 3 & " " ' I later wont the actual row in the datadump worksheet, so that is 3 higher than the "row" number in  arrAllDts()  because I captured just the range from the 4th row  --    "A4:M........
         Else
         End If
        Next Cnt                              ' ----------------------Going through all data rows
     Let strRws = Left(strRws, (Len(strRws) - 1))   ' Take of last  " "  which I do not need
    Dim arrRws() As String ' The VBA string function returns field of string type elements. So I must Dim my array elements appropriately
     Let arrRws() = Split(strRws, " ", -1, vbBinaryCompare) ' This gives us an array which is the row numbers  in the  Datadump  for this unique identifier
     Let ThisWorkbook.Worksheets("arrRws").Range("A1").Resize(1, (UBound(arrRws()) + 1)).Value = arrRws() '   arrRws().JPG - https://imgur.com/HDgpyQq                          -
     ThisWorkbook.Worksheets("arrRws").Columns.AutoFit
    '3b) In the  "Magic Code line"  below we need a  "vertical" array     https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172
    Dim arrRwsT() As Long
     ReDim arrRwsT(1 To UBound(arrRws()) + 1, 1 To 1) ' a  "Vertical"  1 column array
        For Cnt = 1 To UBound(arrRws()) + 1
         Let arrRwsT(Cnt, 1) = arrRws(Cnt - 1)
        Next Cnt
    Let ThisWorkbook.Worksheets("arrRwsT").Range("A1:A" & UBound(arrRws()) + 1 & "").Value = arrRwsT()  '                             -         arrRwsT().JPG - https://imgur.com/syf0PaZ
    Rem 4 Make Vouchers for current unique identifier, Stear
    ' 4a)
    Dim arrVouch() As Variant    '     https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172
     Let arrVouch() = WsTp.Range("A1:K24").Value
    ' 4b) An array just containing the rows for the current Idt
    Dim Clms() As Variant: Let Clms() = Evaluate("=Column(A:N)")    '   {1, 2, 3, 4......14} -   Clms().jpg  -  https://imgur.com/xHlUeH9
    Dim arrDtsSrc() As Variant  '    For   "Magic Code line"     https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172
     Let arrDtsSrc() = Application.Index(WsDta.Cells, arrRwsT(), Clms())  ' - --"Magic Code line"      -  arrDtsSrc().JPG : https://imgur.com/0c8SgIn
     Let ThisWorkbook.Worksheets("arrDtsSrc").Range("A1").Resize(UBound(arrDtsSrc(), 1), UBound(arrDtsSrc(), 2)).Value = arrDtsSrc() '                             -         arrRwsT().JPG - https://imgur.com/syf0PaZ
    Dim RwCnt As Long: Let RwCnt = 1: Let Cnt = 1
    ' 4c)
        Do While RwCnt < DteSrcRwCnt + 1 ' ............................................
            Do While Cnt < 11 ' _________________________________|
             '   Fill in values in Voucher Array
             Let arrVouch(Cnt + 9, 1) = "'" & arrDtsSrc(RwCnt, 2)   '  The extra   "'"   is one way to keep the leading 0s
             Let arrVouch(Cnt + 9, 4) = arrDtsSrc(RwCnt, 3)    '   Detail  ( Item )
             Let arrVouch(Cnt + 9, 7) = arrDtsSrc(RwCnt, 4)    '   Unit Code
             Let arrVouch(Cnt + 9, 9) = arrDtsSrc(RwCnt, 11)    '   Value
             Let Cnt = Cnt + 1
             Let RwCnt = RwCnt + 1
            Loop ' While Cnt < 11 ' ______________________________|
         Let arrVouch(6, 3) = Split(Stear, "_", 2, vbBinaryCompare)(1) ' The second array element (1) is  source code & source name  ( The first array element (0) is the date )
         Let arrVouch(4, 10) = Split(Stear, "_", 2, vbBinaryCompare)(0) ' The first array element (0) is the date
         Let Cnt = 1                       ' back to first row for a template
     '4d) Information to the summary sheet.
        Dim NxtVch As Long: Let NxtVch = WsSmry.Range("A" & WsSmry.Rows.Count & "").End(xlUp).Row
         Let WsSmry.Range("A" & NxtVch + 1 & "").Value = "V" & Format(NxtVch, "0000")
         Let WsSmry.Range("B" & NxtVch + 1 & "").Value = Split(Stear, "_", 2, vbBinaryCompare)(0)
         WsSmry.Hyperlinks.Add Anchor:=WsSmry.Range("C" & NxtVch + 1 & ""), Address:="", SubAddress:="V" & Format(NxtVch, "0000") & "!A1", TextToDisplay:="Go To Sheet"
     '4e)  Add next voucher
         WsTp.Copy After:=WsDta
         Let ActiveSheet.Name = "V" & Format(NxtVch, "0000")
         Let ThisWorkbook.Worksheets("arrVouch").Range("A1").Resize(UBound(arrVouch(), 1), UBound(arrVouch(), 2)).Value = arrVouch() '                             -         arrRwsT().JPG - https://imgur.com/syf0PaZ
         Let ActiveSheet.Range("A1").Resize(UBound(arrVouch(), 1), UBound(arrVouch(), 2)).Value = arrVouch()
         Let arrVouch() = WsTp.Range("A1:K24").Value  ' get a new template array
    
        Loop ' While RwCnt < DteSrcRwCnt ' .............................................

     Let DteSrcRwCnt = 0 ' ready for next Idt Stear
    Next Stear         ' === Main Outer loop =========================================================================

End Sub

**DocAElstein** · 01-11-2020, 06:29 PM

In support of this Post:
http://www.excelfox.com/forum/showth...ll=1#post11847

Before
_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D
1	Voucher	Date	Link
2

Worksheet: Summary

After for first two vouchers
_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C
1	Voucher	Date	Link
2	V0001	01.01.2020	Go To Sheet
3	V0002	01.01.2020	Go To Sheet
4

Worksheet: Summary

After for all vouchers
Remove this code line

Code:

 ReDim arrUnicDtsSrc(0 To 0): Let arrUnicDtsSrc(0) = "01.01.2020_99909900 - A" ' ***** I am limiting it to the first unique identifier, ( 01.01.2020_99909900 - A ) just for demo purposes. If you remove this line,  then you will see that all dates and sources  will be considered

_____ Workbook: BeforeDumpTemplate.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C
1	Voucher	Date	Link
2	V0001	01.01.2020	Go To Sheet
3	V0002	01.01.2020	Go To Sheet
4	V0003	01.01.2020	Go To Sheet
5	V0004	01.01.2020	Go To Sheet
6	V0005	01.01.2020	Go To Sheet
7	V0006	02.01.2020	Go To Sheet
8	V0007	03.01.2020	Go To Sheet
9	V0008	04.01.2020	Go To Sheet
10	V0009	05.01.2020	Go To Sheet
11	V0010	06.01.2020	Go To Sheet
12	V0011	07.01.2020	Go To Sheet
13	V0012	08.01.2020	Go To Sheet
14	V0013	09.01.2020	Go To Sheet
15	V0014	10.01.2020	Go To Sheet
16	V0015	11.01.2020	Go To Sheet
17	V0016	12.01.2020	Go To Sheet
18	V0017	13.01.2020	Go To Sheet
19	V0018	14.01.2020	Go To Sheet
20	V0019	15.01.2020	Go To Sheet
21

Worksheet: Summary

**DocAElstein** · 01-20-2020, 06:34 PM

Coding for these Threads
https://stackoverflow.com/questions/...ication-ontime
http://www.excelfox.com/forum/showth...ll=1#post11870
https://stackoverflow.com/questions/...12342#59812342

Open workbook - MainFile.xls : https://app.box.com/s/prqhroiqcb0qccewz5si0h5kslsw5i5h

Module “Modul1” in MainFile.xls
(This is the main module from which all macros are run)

Code:

Option Explicit
' Public variable code section
Private Pbic_Arg1 As String
Public Pbic_Arg2 As Double


Dim sTemp As String
 ' _
_
 
 
Sub MainMacro()    '    https://stackoverflow.com/questions/31439866/multiple-variable-arguments-to-application-ontime/31464597       http://markrowlinson.co.uk/articles.php?id=10
Rem 1
                                                                                                                                                                                                                          Debug.Print "Rem 1" & vbCr & vbLf & "This workbook module, single arrgument"
' This workbook module, single argument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"            &           "!'Modul1.UnderMainMacro 465'": Debug.Print "!'Modul1.UnderMainMacro 465'"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"            &           "!'Modul1.UnderMainMacro ""465""'": Debug.Print "!'Modul1.UnderMainMacro ""465""'"
 Application.OnTime Now(), "'Modul1.UnderMainMacro  465'" '  --- more usual simplified form. In this case I nned the extra  Modul1.  because Sub UnderMainMacro( ) is private
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "UverFile module, single argument"
' UverFile module, single argument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"               &            "!'Modul1.MacroInUverFile 465'": Debug.Print "!'Modul1.MacroInUverFile 465'"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"               &             "!'Modul1.MacroInUverFile ""465""'": Debug.Print "!'Modul1.MacroInUverFile ""465""'"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "Thisworkbook module, multiple arguments"
' Thisworkbook module, multiple arguments
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"             &           "!'Modul1.UnderUnderMainMacro 465, 25'": Debug.Print "!'Modul1.UnderUnderMainMacro 465, 25'"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"             &           "!'Modul1.UnderUnderMainMacro 465, ""25""'": Debug.Print "!'Modul1.UnderUnderMainMacro 465, ""25""' "
 Application.OnTime Now(), "'UnderUnderMainMacro 465,  25 '" '  --- more usual simplified form. I don't even need the extra  Modul1.  because it is not private
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "UverFile module, multiple argument"
' UverFile module, multiple argument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"                  &           "!'Modul1.MacroUnderMacroInUverFile 465, 25'": Debug.Print "!'Modul1.MacroUnderMacroInUverFile 465, 25'"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"                  &          "!'Modul1.MacroUndermacroInUverFile 465, ""25""'": Debug.Print "!'Modul1.MacroUndermacroInUverFile 465, ""25""'"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "mess about with argument positions"
' mess about with argument positions
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"               &           "!'Modul1.UnderUnderMainMacro      465   ,     ""25""          '": Debug.Print "!'Modul1.UnderUnderMainMacro      465   ,     ""25""          '"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "This workbook first worksheet code module, single arrgument"
' This workbook first worksheet code module, single arrgument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                &           "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWsCodeModule 465'": Debug.Print "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWcCodeModule 465'"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                 &            "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWsCodeModule ""465""'": Debug.Print "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWcCodeModule ""465""'"
                                                                  Debug.Print vbCr & vbLf & "UverFile  first worksheet code module, single arrgument"
' UverFile  first worksheet code module, single arrgument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"                     &           "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModule 465'": Debug.Print "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModule 465'"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"                     &            "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModule ""465""'": Debug.Print "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModule ""465""'"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "This workbook first worksheet code module, multiple arguments"
' This workbook first worksheet code module, multiple arguments
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                  &             "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWsCodeModuleMultipleArguments 465      ,  ""25""         '": Debug.Print "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWcCodeModuleMultipleArguments 465      ,  ""25""         '"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                  &            "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWsCodeModuleMultipleArguments      ""465""   ,   25    '": Debug.Print "!'" & ThisWorkbook.Worksheets.Item(1).CodeName & ".InLisWbFirstWcCodeModuleMultipleArguments      ""465""   ,   25    '"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "UverFile  first worksheet code module, Multiple  arrgument"
' UverFile  first worksheet code module, Multiple  arrgument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"                    &           "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModuleMultipleArguments   465   ,    ""25""       '": Debug.Print "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModuleMultipleArguments   465   ,    ""25""       '"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & "UverFile.xls" & "'"                    &           "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModuleMultipleArguments ""465""   ,    ""25""  '": Debug.Print "!'" & "Tabelle1" & ".InUverFileFirstWsCodeModuleMultipleArguments ""465""   ,    ""25""  '"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "Doubles do not have to be in quotes either  ' This workbook module, double argument arrgument"
' Doubles do not have to be in quotes either  ' This workbook module, double argument arrgument
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                  &           "!'Modul1.DoubleCheck 465.5   , ""25.4""    '": Debug.Print "!'Modul1.DoubleCheck 465.5   , ""25.4""    '"
                                                                                                                              
Rem 2 Variables
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "Rem 2 Variables" & vbCr & vbLf & "'2a)  ""Pseudo""  variables use"
'2a) "Pseudo" variables use
Dim Arg1_str465 As String, Arg2_Dbl25 As Double
 Let Arg1_str465 = "465.42": Let Arg2_Dbl25 = 25.4
 ' Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                 &            "!'Modul1.DoubleCheck  Arg1_str465   ,   Arg2_Dbl25    '": Debug.Print "!'Modul1.DoubleCheck  Arg1_str465   ,   Arg2Db_l25    '"  ' This code line will not work, that is to say it will not find the varables and take  0  values when VBA later runs the Scheduled macro,  Sub DoubleCheck( )
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                   &           "!'Modul1.DoubleCheck   """ & Arg1_str465 & """   ,   """ & Arg2_Dbl25 & """    '": Debug.Print "!'Modul1.DoubleCheck  """ & Arg1_str465 & """  ,   """ & Arg2_Dbl25 & """  '"
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                   &            "!'Modul1.DoubleCheck   """ & Arg1_str465 & """   ,   " & Arg2_Dbl25 & "    '": Debug.Print "!'Modul1.DoubleCheck  """ & Arg1_str465 & """  ,   " & Arg2_Dbl25 & "  '"
                                                                                                                                                                                                                          Debug.Print vbCr & vbLf & "'2b) Real varable use"
'2b) Real varable use
 Let Modul1.Pbic_Arg1 = "465.42": Let Pbic_Arg2 = 25.4
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                   &           "!'Modul1.DoubleCheck   Modul1.Pbic_Arg1     ,   Pbic_Arg2    '": Debug.Print "!'Modul1.DoubleCheck  Modul1.Pbic_Arg1  ,   Pbic_Arg2  '"

 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                   &           "!'Modul1.DoubleCheck Modul1.Pbic_Arg1, Pbic_Arg2'"
                                                                                                                                 ''      Debug.Print Pbic_Arg2 '' This gives 999.99 in  Debug F8  mode , 25.4 in  normal  run

Rem 3 ByRef check
 Application.OnTime Now(), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"                   &           "!'Modul1.ByRefCheck'"
 Application.OnTime Now() + TimeValue("00:00:00"), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"          & "!'Modul1.ByRefCheck'"
 Application.OnTime Now() + TimeValue("00:00:01"), "'" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "'"          & "!'Modul1.ByRefCheck'"
End Sub
Private Sub UnderMainMacro(ByVal Nmbr As Long)
 MsgBox prompt:="Arg1 is   " & Nmbr
End Sub
Sub UnderUnderMainMacro(ByVal Nmbr As Long, ByVal NuverNmbr As Long)
 MsgBox prompt:="Arg1 is  " & Nmbr & ", Arg2 is  " & NuverNmbr
End Sub
Sub DoubleCheck(ByVal DblNmr1 As Double, ByRef DblNmr2 As Double) ' provided the signature line is declared appropriately, all number argument types dont have to be in  ""
 MsgBox prompt:="Arg1 is  " & DblNmr1 & ", Arg2 is  " & DblNmr2
 Let DblNmr2 = 999.99
End Sub


Sub ByRefCheck()
 Debug.Print vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & "Rem 3     ByRef Check" & vbCr & vbLf & Pbic_Arg2
End Sub

**DocAElstein** · 01-21-2020, 04:57 PM

Coding in support of this Thread

Code:

Option Explicit
' Module scope variable code section
Public Eye As Long
Private Jay As Long
Dim KEh As Long

' Main scheduling macro 1
Sub ByVal_GEhtitsAppObj_1()
1 Application.OnTime Now(), "'CalledByVal Eye, Jay, KEh'"
 Let Eye = 11: Let Jay = 12: Let KEh = 13

 Application.OnTime Now() + TimeValue("00:00:01"), "'WtchaGotModScopeVariables'"
End Sub

' Main scheduling macro 2
Sub ByVal_GEhtitsAppObj_2()
2 Application.OnTime Now(), "'CalledByVal Module1.Eye, Module1.Jay, Module1.KEh'"   '_--- Fix _ 2)   Module1.MyVariable
 Let Eye = 21: Let Jay = 22: Let KEh = 23
 
 Application.OnTime Now() + TimeValue("00:00:01"), "'WtchaGotModScopeVariables'"
End Sub

' Main scheduling macro 3
Sub ByRef_GEhtitsAppObj_3()
3 Application.OnTime Now(), "'CalledByRef Eye, Jay, KEh'"
 Let Eye = 31: Let Jay = 32: Let KEh = 33
 
 Application.OnTime Now() + TimeValue("00:00:01"), "'WtchaGotModScopeVariables'"
End Sub

' Main scheduling macro 4
Sub ByRef_GEhtitsAppObj_4()
4 Application.OnTime Now(), "'CalledByRef Module1.Eye, Module1.Jay, Module1.KEh'"    '_--- Fix _ 2)   Module1.MyVariable
 Let Eye = 41: Let Jay = 42: Let KEh = 43
 
'  Application.OnTime Now(), "'WtchaGotModScopeVariables'" ' ByRef is not working if this is done
 Application.OnTime Now() + TimeValue("00:00:01"), "'WtchaGotModScopeVariables'"     '_--- Fix _ 1)  to get ByRef to work
End Sub

Sub WtchaGotModScopeVariables()
 Debug.Print Eye & "  " & Jay & "    " & KEh & vbCr & vbLf
End Sub





Sub CalledByVal(ByVal I As Long, ByVal J As Long, ByVal K As Long)
 Debug.Print I & "  " & J & "    " & K
 Let I = I + 1000: Let J = J + 1000: Let K = K + 1000
End Sub
Sub CalledByRef(ByRef I As Long, ByRef J As Long, ByRef K As Long)
 Debug.Print I & "  " & J & "    " & K
 Let I = I + 2000: Let J = J + 2000: Let K = K + 2000
End Sub



'Results
' Macro 1
'  11  0    0
'  11  12    13
'
' Macro 2
'  21  22    23
'  21  22    23
'
' Macro 3
'
'  Fail!!!!!
'
'
' Macro 4
'  41  42    43
' 2041  2042    2043
'
'
'
'
'
'
'
'
'











































































































'
'
'
'
'
'
'
'
'
'
'

Sub GEhtitsAppObject()
1
2  Rem 1 Simple use of variables
  Let Eye = 31: Let Jay = 32: Let KEh = 33
3  Debug.Print Eye & "  " & Jay & "    " & KEh
  Let Eye = 41: Let Jay = 42: Let KEh = 43
4  Debug.Print Module1.Eye & "  " & Module1.Jay & "    " & Module1.KEh
5
6  Rem 2 Call ing Subs with variable arguments
  Let Eye = 71: Let Jay = 72: Let KEh = 73
7  Call CalledByVal(Eye, Jay, KEh)
  Let Eye = 81: Let Jay = 82: Let KEh = 83
8  Call CalledByVal(Module1.Eye, Module1.Jay, Module1.KEh)
9
  Let Eye = 101: Let Jay = 102: Let KEh = 103
10 Call CalledByRef(Eye, Jay, KEh)
  Let Eye = 111: Let Jay = 112: Let KEh = 113
11 Call CalledByRef(Module1.Eye, Module1.Jay, Module1.KEh)
12
13 Rem 3 Application.OnTime
  Let Eye = 141: Let Jay = 142: Let KEh = 143
14  Application.OnTime Now(), "'CalledByVal Module1.Eye, Module1.Jay, Module1.KEh'"
  Let Eye = 151: Let Jay = 152: Let KEh = 153
15  Application.OnTime Now(), "'CalledByVal Eye, Jay, KEh'"
16
  Let Eye = 171: Let Jay = 172: Let KEh = 173
17  'Application.OnTime Now(), "'CalledByRef Eye, Jay, KEh'"
  Let Eye = 181: Let Jay = 182: Let KEh = 183
18  Application.OnTime Now(), "'CalledByRef Module1.Eye, Module1.Jay, Module1.KEh'"
19
End Sub







'20 Rem 4 Application.Run
'  Let Eye = 211: Let Jay = 212: Let KEh = 213
'21 Application.Run "CalledByVal", Eye, Jay, KEh
'  Debug.Print Eye & "  " & Jay & "    " & KEh
'
'  Let Eye = 221: Let Jay = 222: Let KEh = 223
'22 Application.Run "CalledByVal", Module1.Eye, Module1.Jay, Module1.KEh
'  Debug.Print Eye & "  " & Jay & "    " & KEh
'23
'
'  Let Eye = 241: Let Jay = 242: Let KEh = 243
'24 Application.Run "CalledByRef", Module1.Eye, Module1.Jay, Module1.KEh
'  Debug.Print Eye & "  " & Jay & "    " & KEh
'
'  Let Eye = 251: Let Jay = 252: Let KEh = 253
'25 Application.Run "CalledByRef", Eye, Jay, KEh
'  Debug.Print Eye & "  " & Jay & "    " & KEh
'
'End Sub
'    Sub CalledByVal(ByVal I As Long, ByVal J As Long, ByVal K As Long)
'     Debug.Print I & "  " & J & "    " & K
'     Let I = I + 1000: Let J = J + 1000: Let K = K + 1000
'    End Sub
'    Sub CalledByRef(ByRef I As Long, ByRef J As Long, ByRef K As Long)
'     Debug.Print I & "  " & J & "    " & K
'     Let I = I + 2000: Let J = J + 2000: Let K = K + 2000
'    End Sub