Page 1 of 4 123 ... LastLast
Results 1 to 10 of 40

Thread: Notes tests. Excel VBA Folder File Search

  1. #1
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10

    Notes tests. Excel VBA Folder File Search

    Re: Appendix Thread. ( Codes for other Threads, HTML Tables, etc. )

    Hi
    . I would like to use this Thread as an Appendix for codes in other Threads so as to help reduce clutter in that Thread should the code be a bit long, or not directly relevant.
    . Also as HTML code is on in this Test Sub Forum I would like to reference HTML Tables should I wish to use them in answering threads

    @ Moderators, Administrator:
    . I hope the above is OK to do and if so please do not delete this Thread. ( Or advise if I should post my "Appendix" somewhere else ( If possible where HTML code is on ) )
    .
    . Many Thanks
    Alan



    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vOQApTgb
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vbihZ-7W
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vfmpSO0F
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vjfTJ7lX
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vmq-LHHz
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vst3j_7i
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwBqjIR5 Nj
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwBw8El0 r5
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwC63GbR uM
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwC9fyKZ do
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwCEn8DB Qe
    https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bw0Bey8g QO
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 09-22-2023 at 05:32 PM.

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    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

  3. #3
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    Function Code for getting Column Letter from Column Number
    Shortened version used in Post #14
    http://www.excelfox.com/forum/showth...=9837#post9837
    Public Function CL(ByVal lclm As Long) As String

    And Fuller version with explaining 'Comments


    Code:
    Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function
    
    Function FukOutChrWithDoWhile(ByVal lclm As Long) As String 'Using chr function and Do while loop      For example http://www.excelforum.com/excel-programming-vba-macros/796472-how-to-go-from-column-number-to-column-letter.html
    Dim rest As Long 'Variable for what is "left over" after subtracting as many full 26's as possible
        Do
        '    Let rest = ((lclm - 1) Mod 26) 'Gives 0 to 25 for Column Number "Left over" 1 to 26. Better than ( lclm Mod 26 ) which gives 1 to 25 for clm 1 to 25 then 0 for 26
        '    Let FukOutChrWithDoWhile = Chr(65 + rest) & FukOutChrWithDoWhile 'Convert rest to Chr Number, initially with full number so the "units" (0-25), then number of 26's left over (if the number was so big to give any amount of 26's in it, then number of 26's in the 26's left over (if the number was so big to give any amount of 26 x 26's in it, Enit ?
        '    'OR
        Let FukOutChrWithDoWhile = Chr(65 + (((lclm - 1) Mod 26))) & FukOutChrWithDoWhile
        Let lclm = (lclm - (1)) \ 26 'This gives the number of 26's ( if any ), but just the excact part, in the next number down , - so applying the rest formula to this new number will again leave a difference "left over" rest.
        'lclm = (lclm - (rest + 1)) \ 26 ' As the number is effectively truncated here, any number from 1 to (rest +1)  will do in the formula
        Loop While lclm > 0 'Only loop further if number was big enough to still have 0-25's in it
    End Function
    Rem Ref    http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Rem Ref    http://www.excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html

  4. #4
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    The code to step through while reading Posts from
    http://www.excelfox.com/forum/showth...=9517#post9517
    from Post #25 http://www.excelfox.com/forum/showth...tenation/page3
    http://www.excelfox.com/forum/f2/spe...42/index3.html

    Code:
    Sub EvalutingQuotes() 'Posts from #25   http://www.excelfox.com/forum/f2/special-concatenation-2042/index3.html
    
    Rem 1) Basics
    Dim v As Variant
    Let v = "3" '  Results in a Variant variable containing a string value "3"
    Let v = 3 '    Results in a Variant variable containing a Long Number 3 ( actually an Integer ? )
    
    Range("I1").Value = Evaluate("=A1") 'Explicit Version
    Range("I1").Value = Evaluate("=" & Range("A1").Address & "") 'Explicit Version
    Range("I1").Value = Evaluate("" & Range("A1").Address & "") 'Implicit Default
    
    Range("I1").Value = Evaluate("       " & Range("A1").Address & "       ") '
    
    Range("I1").Value = Evaluate(Range("A1").Address) 'Common but dangerous variation
    
    Rem 2) Detailed code anylysis
    Dim strEval As String 'String to be used in Evaluate
    
    10  strEval = "=A1" & "&" & "A1": Debug.Print strEval 'gives =A1&A1
    Range("I1").Value = Evaluate("" & strEval & "") 'Result Gives 11 in cell I1
    
    20  'strEval = "=A1" & "&"" & ";" & ""&" & "A1": Debug.Print strEval 'gives syntax error
    'Range("I1").Value = Evaluate("" & strEval & "") 'errors
    
    30  strEval = "=A1" & "&"";""&" & "A1": Debug.Print strEval 'gives =A1&";"&A1
    Range("I1").Value = Evaluate("" & strEval & "") 'Result Gives 1;1
    
    40  strEval = "=A1" & "&"";""": Debug.Print strEval 'gives =A1&";"
    Range("I1").Value = Evaluate("" & strEval & "") 'Gives 1;
    
    50  strEval = "=A1" & "&"";" & """": Debug.Print strEval 'gives =A1&";"
    Range("I1").Value = Evaluate("" & strEval & "") 'Gives 1;
    
    60  strEval = "=A1" & "&"";""""" & """": Debug.Print strEval 'gives =A1&";" ""
    Range("I1").Value = Evaluate("" & strEval & "") 'error
    70  strEval = "=A1" & "&"";"";""" & """": Debug.Print strEval 'gives=A1&";";""
    Range("I1").Value = Evaluate("" & strEval & "") 'error
    
    80  strEval = "=A1" & "&"";""""" & """": Debug.Print strEval 'gives =A1&";"""
    Range("I1").Value = Evaluate("" & strEval & "") 'Did not error  Gives 1;"  !!!!!!!!
    
    90  strEval = "=A1" & "&"";""" & """" & """": Debug.Print strEval 'gives =A1&";"""
    Range("I1").Value = Evaluate("" & strEval & "") 'Did not error  Gives 1;"  !!!!!!!!
    
    Rem 3
    100 strEval = "=A1" & "&"";""""""": Debug.Print strEval 'gives =A1&";"""
    Range("I1").Value = Evaluate("" & strEval & "") 'Did not error  Gives 1;"  !!!!!!!!
    
    
    End Sub

  5. #5
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10

    Grid coordinates for a Range using [ ] and Evaluate(" ") through a named Range

    Obtaining grid coordinates for an Area of contiguous cells in a Spreadsheet using [ ] and Evaluate(“ “) through the use of a Named Range for that Area

    Aka ' It is a Range Name Test : Its n Range Name Test : 's 'n Rng Name Test : s n Rg Name Testie : snRg.Name = "snRgNme"
    This code is in support of other Posts in various Threads. ( I will edit the Links as I reference this post )
    For example:
    http://www.excelforum.com/showthread...t=#post4400666




    The code takes in a hard coded Range, A1:E10.
    That Range is given a Name as held in the Names Register of a Worksheet.
    Various code lines are developed which reference this Named Range and return the Grid Coordinates.

    These coordinates are held within the following Long Type Variables
    Cs is the start column
    sClm is the column count
    stpClm is the stop column
    Rs is the start row
    sRw is the rows count
    stpRw is the stop row


    Code:
    '10   ' It is a Range Name Test : Its n Range Name Test : 's 'n Rng Name Test : s n Rg Name Testie : snRg.Name = "snRgNme"
    Sub snRgNameTest()  ' Inspired by..   snb     .. " array [     ] "       '  http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714
    20    ' Worksheets Info
    30    Dim ws As Worksheet '                                      ' Preparing a "Pointer" to an Initial "Blue Print" ( or a Form, or a Questionnaire not yet filled in, a template   etc.) 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 Object of this type ) . This also us to get easily at the Methods and Properties through the applying of a period ( .Dot) ( intellisense )
    40    'Set ws = ThisWorkbook.Worksheets("NPueyoGyanArraySlicing") 'The worksheets collection object is used to Set ws to the Sheet we are playing with, so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...              ' 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
    50    Set ws = ActiveSheet ' Alternative to last line, make code apply to the current active sheet, - That being "looked at" when running this code        '
    60    Dim vTemp As Variant ' To help development when you are not sure what type is retuned. "Suck and see what comnes out!"  Highlight it and Hit Shift+F9 to see it in the imediate Window
    70    ' Named range referrencing                                                                                                                                      Invoke  Pike  Evaluate Rabbit Rabbit. How's the Bunny ? Bunnytations Banters
    80    Dim snRg As Range: Set snRg = ws.Range("A1:E10")
    90    Dim sName As String: Let sName = "snRgNme" '
    100   Let snRg.Name = "snRgNme"  ' It is a Range Name me  - " 's 'n Range Name me "  ..  "snRgNme"  ;)  This name appears permanentlly in then sheet. It remains referrencing this range unless the name iis deleted or the range referrenced is overwritten by a similar code line which has a different range in it on RHS of =                                                                                                  http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
    110   Let snRg.Name = sName      ' Identical to last line
    120   Dim ReturnedsnRgName As String
    130   Let ReturnedsnRgName = snRg.Name ' The returned name is full, like  "NPueyoGyanArraySlicing!$A$1:$E$10". This will not work in the Address Formulas
    140   Dim NameOnly As String: Let NameOnly = Replace((snRg.Name), "!", "", (InStr(1, (snRg.Name), "!"))):  Debug.Print snRg.Name: Dim pos&: pos = InStr(1, (snRg.Name), "!"): NameOnly = Replace((snRg.Name), "!", "", pos) ' We had  ----  "NPueyoGyanArraySlicing!$A$1:$E$10"   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
    150   Let NameOnly = Replace((ReturnedsnRgName), "!", "", (InStr(1, (ReturnedsnRgName), "!")))
    160      If InStr(NameOnly, "!") > 0 Then MsgBox prompt:="NameOnly is " & vbCr & """" & NameOnly & """" & vbCr & "so will chop off up to and including the ""!""": Let NameOnly = Replace((NameOnly), "!", "", (InStr(1, (NameOnly), "!"))) ' Just to demo that you need to do this if you are not sure that a ! is there, or the code line would error if no ! was in there..
    170  '
    180   ' Count, Start, and Stop of columns in an Area of contiguous cells in a Spreadsheet
    190   Dim sClm As Long 'Variable for ColumnsCount.             -This makes a Pigeon Hole sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. Long is very simple to handle, final memory "size" type is known (13.456, 00.001 have same "size" computer memory ),so an Address suggestion can be given for when the variable is filled in. (Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.-upon/after 32-bit, Integers (Short) need converted internally anyway, so a Long is actually faster)
    200   Let sClm = Evaluate("columns(snRgNme)") ' = 5
    210   'Let sClm = Evaluate("columns(RetunedsnRgName)") 'Run time Error as expected
    220   Let sClm = [columns(snRgNme)]           ' = 5              'Is this Most Powerful Command in VBA?, or what ...    http://www.ozgrid.com/forum/showthread.php?t=52372       http://www.mrexcel.com/forum/excel-questions/899117-visual-basic-applications-range-a1-a5-vs-%5Ba1-a5%5D-benefits-dangers.html
    230   'Let sClm = [columns(RetunedsnRgName)]           'Run time Error as expected
    240   Let sClm = [columns(A1:E10)]             ' = 5
    250                                                               Let vTemp = Evaluate("column(snRgNme)") ' Reveals an Array {1, 2, 3, 4, 5}  -  1 Dimension "pseudo Horizontal" Array
    260   Dim Cs As Long 'Variable for Start Column
    270   Let Cs = Evaluate("column(A1:E10)")(1)
    280   Let Cs = Evaluate("column(snRgNme)")(1) ' = 1
    290                                                               Let vTemp = [column(snRgNme)]: vTemp = vTemp(1) ' Anololie erklart:   http://www.excelforum.com/showthread.php?t=1141369&p=4398930&highlight=#post4398930    http://www.excelforum.com/showthread.php?t=1141369&p=4398966#post4398966
    300   Let Cs = [column(A1:E10)]()(1)
    310   Let Cs = [column(snRgNme)]()(1)
    320   '
    330   Dim stpClm% ' Variable for Stop column Number               '  ( % is shorthand for As Long ..http://www.excelforum.com/showthread.php?t=1116127&p=4256569#post4256569
    340   Let stpClm = Cs + (sClm - 1)             ' = 5
    350   ' [ ]
    360   Let stpClm = [column(snRgNme)]()(1) + ([columns(snRgNme)] - 1)
    370   Let stpClm = [column(snRgNme)]()(1) + ([columns(snRgNme)] - 1)
    380   ' In between step [ ] and Evaluate(" ")
    390   Let stpClm = [column(snRgNme)]()(UBound([column(snRgNme)]))
    400   ' Now Full Evaluate(" ")
    410   Let stpClm = Evaluate("column(snRgNme)")(1) + (Evaluate("columns(snRgNme)") - 1)
    420   Let stpClm = Evaluate("column(snRgNme)")(UBound(Evaluate("column(snRgNme)")))
    430  '
    440   ' Start, Count and Stop of rows in an Area of contiguous cells in a Spreadsheet
    450   Dim sRw As Long 'Rows Count
    460   Let sRw = Evaluate("rows(snRgNme)")
    470   Let sRw = [rows(snRgNme)]
    480   Let sRw = [rows(A1:E10)]
    490                                                               Let vTemp = Evaluate("row(snRgNme)") ' = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
    500   Dim Rs As Long 'Start Row
    510   Let Rs = Evaluate("row(A1:E10)")(1, 1) 'Note a 2 Dimensional,  1 column, "vertical" Array is returned : ' vTemp = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
    520   Let Rs = Evaluate("row(snRgNme)")(1, 1)
    530                                                               Let vTemp = [row(snRgNme)]: vTemp = vTemp(1, 1)
    540   Let Rs = [row(A1:E10)]()(1, 1)
    550   Let Rs = [row(snRgNme)]()(1, 1)
    560  '
    570   Dim stpRw% 'Stop Row
    580   Let stpRw = Rs + (sRw - 1)
    590   Let stpRw = [row(snRgNme)]()(1, 1) + ([rows(snRgNme)] - 1)
    600   Let stpRw = [row(snRgNme)]()(1, 1) + ([rows(snRgNme)] - 1)
    610  '
    620   Let stpRw = [row(snRgNme)]()(UBound([row(snRgNme)], 1), 1) 'UBound([row(snRgNme)], 1) is Ubound first ( "row" ) dimension.  UBound([row(snRgNme)], 2) would be the second dimension ( "column" ) count
    630  '
    640   Let stpRw = Evaluate("row(snRgNme)")(1, 1) + (Evaluate("rows(snRgNme)") - 1)
    650   Let stpRw = Evaluate("row(snRgNme)")(UBound(Evaluate("row(snRgNme)")), 1)
    660  '
    End Sub
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  6. #6
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10

    ' Delete One Row From A 2D Variant Array

    "Opened up" Rick code:

    ' To Test Function, Type some arbitrary values in range A1:E10, step through Test 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

    (_... Original Code:
    ' http://www.excelfox.com/forum/showth...=9658#post9658
    ....)


    Code:
    ' To Test Function, Type some arbitrary values in range A1:E10, step through Test 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=9658#post9658
    Sub Rick()
    Dim sp() As Variant
    Dim DataArr() As Variant: Let DataArr() = Range("A1:E10").Value
     Let sp() = Fu_Rick(DataArr(), 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_Rick(ByRef arrIn() As Variant, ByVal RowToDelete As Long) As Variant
    _... in next Post
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  7. #7
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  8. #8
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10

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

    "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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  9. #9
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  10. #10
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10

    Delete One Row From A 2D Excel Range Area

    ' 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








    Main Test Code ( Required Function given a couple of Posts down )


    Code:
    ' Delete One Row From A 2D Excel Range Area
    ' 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
    
    Sub Alan()
    Dim sp() As Variant
        'Dim DataArr() As Variant: Let DataArr() = Range("A1:E10").Value
     Let sp() = FuR_Alan(Range("A1:E10"), 5)
     'Let sp() = FuRSHg(Range("A1:E10"), 5)
     'Let sp() = FuRSHgDotT(Range("A1:E10"), 5)
     'Let sp() = FuRSHgShtHd(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

    _............


    For no particular reason I am considering this as my Input "Area"

    Using Excel 2007 32 bit
    Row\Col
    A
    B
    C
    D
    E
    F
    1 0 10 20 30 40
    2 2 12 22 32 42
    3 4 14 24 34 44
    4 6 16 26 36 46
    5 8 18 28 38 48
    6 10 20 30 40 50
    7 12 22 32 42 52
    8 14 24 34 44 54
    9 16 26 36 46 56
    10 18 28 38 48 58
    11
    Sheet: NPueyoGyanArraySlicing




    _.......

    Expected Output shown in next Post
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

Similar Threads

  1. Tests and Notes on Range Referrencing
    By DocAElstein in forum Test Area
    Replies: 70
    Last Post: 02-20-2024, 01:54 AM
  2. Tests and Notes for EMail Threads
    By DocAElstein in forum Test Area
    Replies: 29
    Last Post: 11-15-2022, 04:39 PM
  3. Replies: 49
    Last Post: 03-20-2018, 04:09 PM
  4. Replies: 1
    Last Post: 02-14-2013, 12:09 PM
  5. List File name in folder to excel with images
    By Ryan_Bernal in forum Excel Help
    Replies: 2
    Last Post: 01-15-2013, 11:37 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •