Notes tests. Application.Run.OnTime Multiple Variable Arguments ByRef ByVal

**DocAElstein** · 06-07-2016, 10:32 PM

Function Required for last Post:

Code:

Function Fu_Rick(ByRef arrIn() As Variant, ByVal RowToDelete As Long) As Variant
10  ' use "neat magic" code line    arrOut() = Application.Index(arrIn(), rwsT(), clms())
20  ' So we have directly the Input Array, arrIn(). For clms(), do some extra stuff to get a column letter ( usiing the Split Address Method ) then column indices diectly from Spreadsheet column() Function. Rows from joinig the Row indicies above and below the row to be deleted
30                                          Dim Cols As String: Cols = "A:" & Split(Columns(UBound(arrIn(), 2) - LBound(arrIn(), 2) + 1).Address(, 0), ":")(0)
40  '                                       Fu_Rick = Application.Index(arrIn(), Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")"))))), Evaluate("COLUMN(" & Cols & ")"))
50
60  '   clms() = { 1, 2, 3, 4, 5 }
61  'clms()   Rick     Evaluate("COLUMN(" & "A:" & Split(Columns(UBound(arrIn(), 2) - LBound(arrIn(), 2) + 1).Address(, 0), ":")(0) & ")")
70   '  Start point is last column in Output Array using..   Split Address technique     http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213969
80   Dim larrClm As Long: Let larrClm = ((UBound(arrIn(), 2) - LBound(arrIn(), 2)) + 1) ' For our Output Array  ( base 1 ) staring at 1 - not yet pinned to a Top left Output Range cell the ( ( stop "column"  - start "column" ) + 1 ) gives "last" "column"
90   Dim AdrsRel As String: Let AdrsRel = Columns(larrClm).Address(ColumnAbsolute:=False) 'False absolute Address gives no $ prefix and format like "E:E" (true Relative Address) , so split by ":" and then either (0) or (1) returned arrAddressSplit() Element will do for the letter..
100  Dim arrAddressSplit() As String
110  Let arrAddressSplit() = VBA.Split(AdrsRel, ":", 2, vbTextCompare) 'Splits  into like ("E", "E") for no or -1 second argument..  Here 2 gives just the 2 you would get E, and E - ...   http://www.mrexcel.com/forum/general-excel-discussion-other-questions/929381-visual-basic-applications-split-function-third-argument-refers-maximum-outputs-%93when-splitting-stops-%94.html
120  Dim clmLtr As String
130  Let clmLtr = arrAddressSplit(0) 'Returns first element "along" in 1 Dimensional "Psuedo Horizontal" Array ( Elements for 1 Dimensional Array are by default 0,1, 2, 3 ....etc )
140  ' Now use spreadsheet column function , column(A:E"), to get a {1, 2, 3, 4, 5} Array
150  Dim clms() As Variant: Let clms() = Evaluate("column(A:" & clmLtr & ")")
 
160  'rwsT()       Rick       Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")")))))
170  'Final required row Indicies, with a missing indicie, as 2 strings ( Hard Copy )
180  Dim strRwsDBelow As String, strRwsDAbove As String, strrwsD As String
190  Let strRwsDBelow = "1 2 3 4": Let strRwsDAbove = "6 7 8 9 10"
200  Let strrwsD = "1 2 3 4" & " " & "6 7 8 9 10"
210  Let strrwsD = strRwsDBelow & " " & strRwsDAbove
220
230
240  'Get row indicies conveniently from Row Function - ( correct "orintation" to use in "neat magic" code line, but wrong "orientation" to use Join Function {1; 2; 3; 4}   and   {6; 7; 8; 9; 10}  )
250  Dim arr_2D1rowBelow() As Variant, arr_2D1rowAbove() As Variant
260  Let arr_2D1rowBelow() = Evaluate("Row(1:" & (RowToDelete - 1) & ")") ' 1 To 4, 1 To 1 {1; 2; 3; 4} Array
270  Let arr_2D1rowAbove() = Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")") ' 1 To 5, 1 To 1 {6; 7; 8; 9; 10} Array
280  'Get sequential below and above  row strings....   transpose back again! so Join will work, dear oh dear.....
290  Let strRwsDBelow = Join(Evaluate("transpose(Row(1:" & (RowToDelete - 1) & "))"), " ") 'Join must have eindimensional Array, as given by transpose working on a 2D 1 column Array
300  Let strRwsDBelow = Join(Application.Transpose((Evaluate("Row(1:" & (RowToDelete - 1) & ")"))), " ") '   "1 2 3 4"
310  Let strRwsDBelow = Join(Application.Transpose((arr_2D1rowBelow())), " ") '   "1 2 3 4"
320  Let strRwsDAbove = Join(Application.Transpose((arr_2D1rowAbove())), " ") '   "6 7 8 9 10"
  
330 'Final required row Indicies, with a missing indicie, as a string
340  Let strrwsD = strRwsDBelow & " " & strRwsDAbove
350
360 'Split Final String by " " to get 1 1D "Pseudo Horizontal" Array
370 Dim rws() As String: Let rws() = VBA.Split(strrwsD, " ") ' 1 D Array
380 'final Transposed Array for "magic neat" code line
390 Dim rwsT() As Variant: Let rwsT() = Application.Transpose(rws()) ' 2 D 1 "column" Array
400
440 'Output Array
450 Dim arrOut() As Variant
460 Let arrOut() = Application.Index(arrIn(), rwsT(), clms())
470
480 Let Fu_Rick = arrOut()
490 'Or
 Fu_Rick = Application.Index(arrIn(), Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")"))))), Evaluate("COLUMN(" & "A:" & Split(Columns(UBound(arrIn(), 2) - LBound(arrIn(), 2) + 1).Address(, 0), ":")(0) & ")"))
End Function

**DocAElstein** · 06-07-2016, 10:39 PM

"Opened up" snb Code

(_.. Original code here
http://www.excelfox.com/forum/showth...=9714#post9714
_........)

' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17

Code:

' Delete One Row From a ... group of contiguous cells in a Spreadsheet

' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight  any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17
' http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714
Sub snb_()
Dim sp() As Variant
 Let sp() = Fu_snb(Range("A1:E10"), 5)
 Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
 Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp
End Sub

Required Function_...
Function Fu_snb(ByVal sn As Range, ByVal y As Long) As Variant
_...in next Post

**DocAElstein** · 06-07-2016, 10:42 PM

Required Function for last Post

Code:

Function Fu_snb(ByVal sn As Range, ByVal y As Long) As Variant
10   ' use "neat magic" code line    arrOut() = Application.Index(arrIn(), rwsT(), clms())       http://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html        http://www.mrexcel.com/forum/excel-questions/908760-visual-basic-applications-copy-2-dimensional-array-into-1-dimensional-single-column-2.html#post4375354
20   ' So we have sn as a range sn,  ( can be uses syntaxly for arrIn() in "neat magic" line. ). Consequtive columns indicies  as simple transpose of consequtive row Indicies from Spreadsheet row Funnction. Row indicies as the consequtive row indicies with the row to be deleted taken out
30   ' so snb does                   arrOut() = Application.Index(sn, rwsT(), clms())
40
50
60  '   clms() = { 1, 2, 3, 4, 5 }
70  'clms()
80   Dim clms() As Variant: Let clms() = Evaluate("column(A1:E10)")
90   Let clms() = Evaluate("column(" & sn.Address & ")")
100  Dim sName As String: Let sName = "snb_002"
110  Let sn.Name = sName
120  Let clms() = Evaluate("column(" & sName & ")")
129  Let clms() = Evaluate("column(snb_002)")
130    '== DANGER: === Pitful: Above we gave the Range Object a Name, but now see what  "Name"  or  "Name" 's  comes back "!"  !
132     Dim retRefstrName As String, retObjName As Object
133     Let retRefstrName = sn.Name: Set retObjName = sn.Name: Debug.Print sn.Name 'something of the form   "NPueyoGyanArraySlicing!$A$1:$E$10" is reveald in Immediate ( Ctrl+G when in VB Editor ) Window
134     'Let clms() = Evaluate("column(=NPueyoGyanArraySlicing!$A$1:$E$10)") 'Let clms() = Evaluate("column(" & retRefstrName & ")")' Rintime Error 13: Incompatiblee types
135     Let clms() = Evaluate("column(NPueyoGyanArraySlicing!$A$1:$E$10)") 'Works
137     Dim NameOnly As String: Let NameOnly = Replace((sn.Name), "!", "", (InStr(1, (sn.Name), "!"))):  'Debug.Print sn.Name: Dim pos&: pos = InStr(1, (sn.Name), "!"): NameOnly = Replace((sn.Name), "!", "", pos) ' We had  ----  "NPueyoGyanArraySlicing!$A$1:$E$10" This is a String referrece returned when the Name Object is used directly or set to a String Variable.     so here I return a string that starts at the position of the ! and which replaces in that truncated shortened string -  "!$A$1:$E$10"   the "!" with nothing
138     Let clms() = Evaluate("column(" & NameOnly & ")"): Let clms() = Evaluate("column(" & Replace((sn.Name), "!", "", (InStr(1, (sn.Name), "!"))) & ")")
139
140     Dim strName As String: Let strName = sn.Name.Name: Debug.Print strName: Let strName = retObjName.Name: Debug.Print strName ' returns our original "CoN"
142     Let clms() = Evaluate("column(" & strName & ")")
150     Dim rngF1G2 As Range: Set rngF1G2 = Range("F1:G2"): Let Range("F1:G2").Value = "From Line 150"
151     Let Range("=NPueyoGyanArraySlicing!F1:G2").Value = "From Line 151"
152     Let rngF1G2.Name = "snFG": Let Range("snFG").Value = "From Line 152"
149    '===============
160 'rwsT()          snb   rws() = VBA.Split(Trim(Replace(" " & Join(Evaluate("transpose(row(A1:E10))")) & " ", " " & y & " ", " ")))
170  'Final required row Indicies, with a missing indicie, as a string ( Hard Copy )
180  Dim strrwsD As String
190  Let strrwsD = "1 2 3 4 6 7 8 9 10"
200  Let strrwsD = Replace("1 2 3 4 5 6 7 8 9 10", " 5 ", " ", 1)
210  Dim strRws As String: Let strRws = "1 2 3 4 5 6 7 8 9 10"
220  Let strrwsD = Replace(strRws, " 5 ", " ", 1)
230
240  'Get full sequential row conveniently from Row Function - ( correct "orientation" to use in "neat magic" code line, but wrong "orientation" to use Join Function {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}  )
250  Dim arr_2D1row() As Variant
260  Let arr_2D1row() = Evaluate("row(A1:E10)") ' 1 To 10, 1 To 1
270
280 'Get full sequential row string.
290  Let strRws = Join(Evaluate("transpose(row(A1:E10))"), " ") 'Join must have eindimensional Array, as given by transpose working on a 2D 1 column Array
300  Let strRws = Join(Application.Transpose((Evaluate("row(A1:E10)"))), " ")
310  Let strRws = Join(Application.Transpose((arr_2D1row())), " ")  '    Join (  Transpose ( { 1; 2; 3; 4; 5; 6; 7; 8; 9; 10} ) ) = Join ( { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10} )
320
330 'Final required row Indicies, with a missing indicie, as a string
340  Let strrwsD = Replace(strRws, " 5 ", " ", 1)
350  Let strrwsD = Replace(strRws, " " & y & " ", " ", 1)
 
360 'Split Final String by " " to get 1 1d "Pseudo Horizontal" Array
370  Dim rws() As String: Let rws() = VBA.Split(strrwsD, " ") ' 1 D Array
380  'Final Transposed Array for "magic neat" code line
390  Dim rwsT() As Variant: Let rwsT() = Application.Transpose(rws()) ' 2 D 1 "column" Array
400
440 'Output Array
450  Dim arrOut() As Variant
460  arrOut() = Application.Index(sn, rwsT(), clms())
470
480  Let Fu_snb = arrOut()
490  'Or
 Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose((Evaluate("row(A1:E10)"))), " "), " " & y & " ", " ", 1), " ")), Evaluate("column(A1:E10)"))
'Finally the "extra" named range bit:
 'Let sn.Name = "snb_002"
 Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose((Evaluate("row(snb_002)"))), " "), " " & y & " ", " ", 1), " ")), Evaluate("column(snb_002)"))
 ' "Shorthand" evaluate
 Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose(([row(snb_002)])), " "), " " & y & " ", " ", 1), " ")), [column(snb_002)])
 'Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Trim(Replace(" " & Join(Evaluate("transpose(row(snb_002))")) & " ", " " & y & " ", " ")))), Evaluate("column(snb_002)"))
 'or
 'Let Fu_snb = Application.Index(sn, Application.Transpose(Split(Trim(Replace(" " & Join([transpose(row(snb_002))]) & " ", " " & y & " ", " ")))), [column(snb_002)])
End Function