Page 2 of 2 FirstFirst 12
Results 11 to 19 of 19

Thread: Delete One Row From A 2D Variant Array

  1. #11
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,429
    Rep Power
    10
    clms()


    60 ' clms() = { 1, 2, 3, 4, 5 }

    There are many ways to do this. The simplest would be use of a hard coded Spreadsheet columns( ) Function which in this form ( using the Evaluate Function here to allow VBA to use a Spreadsheet Function ) returns exactly what we want:

    Let clms() = Evaluate (" column( A:E ) " ) ' = { 1, 2, 3, 4, 5 }

    I like the "illogical Human" way that Excel uses a weird Letter system "along" the "top" rather than just sequential numbers as it does "down" the "side" . But it can Cause often a bit of extra work.

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://eileenslounge.com/viewtopic.php?p=316254#p316254
    https://eileenslounge.com/viewtopic.php?p=316280#p316280
    https://eileenslounge.com/viewtopic.php?p=315915#p315915
    https://eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315744#p315744
    https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315680#p315680
    https://eileenslounge.com/viewtopic.php?p=315743#p315743
    https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
    https://eileenslounge.com/viewtopic.php?p=314950#p314950
    https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
    https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
    https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
    https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://eileenslounge.com/viewtopic.php?p=317218#p317218
    https://eileenslounge.com/viewtopic.php?p=316955#p316955
    https://eileenslounge.com/viewtopic.php?p=316955#p316955
    https://eileenslounge.com/viewtopic.php?p=316940#p316940
    https://eileenslounge.com/viewtopic.php?p=316927#p316927
    https://eileenslounge.com/viewtopic.php?p=317014#p317014
    https://eileenslounge.com/viewtopic.php?p=317006#p317006
    https://eileenslounge.com/viewtopic.php?p=316935#p316935
    https://eileenslounge.com/viewtopic.php?p=316875#p316875
    https://eileenslounge.com/viewtopic.php?p=316254#p316254
    https://eileenslounge.com/viewtopic.php?p=316280#p316280
    https://eileenslounge.com/viewtopic.php?p=315915#p315915
    https://eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315744#p315744
    https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315680#p315680
    https://eileenslounge.com/viewtopic.php?p=315743#p315743
    https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
    https://eileenslounge.com/viewtopic.php?p=314950#p314950
    https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
    https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
    https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 05-20-2024 at 04:15 PM.
    ….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!!

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

    rwsT() = { 1; 2; 3; 4; 6; 7; 8; 9; 10 } ___ And Final Output Array arrOut()

    rwsT()
    rwsT()

    160 'rwsT()
    As noted the "magic neat" code line requires this as a "vertical" " Dimensional 1 "column" Array
    The full details are gone through in the codes Linked Appendix Posts.

    Briefly in Works.. ( working backwards )
    The snb and Rick codes are very similar.

    380 Transpose a 1 D "pseudo horizontal" Array of the required row indices to our required "vertical"" orientation

    360 ( 'rws() ) A 1 D "pseudo horizontal" Array is made by splitting a string containing the required row indices

    330
    snb Code takes out ( Replaces it with "nothing" ) the row indicia of the row to be deleted from a string of all row indicies.
    Rick Code sticks together ( concatenates with a space " " between ) a string of the row indicies below the row to be deleted to a string of row indicies above the row to be deleted

    280
    snb Code Transposes a "vertical" Array of all row indicies to get a 1 D "pseudo horizontal" Array which is the required 1 D Array argument syntax for the Join Function, which then is used on this Array to give a String obtained by "joining" these Array Elements together in a string...
    Pseudo Code just to clarify
    "1 2 3 4 5 6 7 8 9 10" = Join ( Transpose ( __ 1
    ____________________________________ 2
    ____________________________________ 3
    ____________________________________ 4
    ____________________________________ 5
    ____________________________________ 6
    ____________________________________ 7
    ____________________________________ 8
    ____________________________________ 9
    ___________________________________ 10 ) )
    Or in Excel convention ( English )
    "1 2 3 4 5 6 7 8 9 10" = Join ( Transpose ( { 1; 2; 3; 4; 5; 6; 7; 8; 9; 10} ) )
    "1 2 3 4 5 6 7 8 9 10" = Join ( { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10} )
    Or
    "1 2 3 4 5 6 7 8 9 10" = Join ( Array1D( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10) )

    Rick code does the same twice to get the strings for Below and Above the row to be deleted.

    240 The start point for the rwsT()
    The spreadsheet row(__:__) Function is conveniently used to get a sequential string of indicies. ( This is actually in the correct final "vertical" Array "orientation" but all the above was necessary to get things in correct orientation for the Join Function.. dear or dear !! )
    snb Code does it for all indicies
    Rick code does it twice to get the Indicies Above and the Indicies Below the row not wanted ( the row to be deleted )

    _...__________________________________


    arrOut() = Application.Index(arrIn(), rwsT(), clms())
    arrOut() = Application.Index(arrIn(), rwsT(), clms())


    440 The obtained row and column indicies Arrays discussed above are used in the above formula
    And
    480 the Final Output Array arrOut() is assigned to the Function so that it will be returned at the Call line of a Calling routine when the Function Ends

    _................................................. .
    ….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!!

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

    My Alternative Codes to .. ' Delete One Row From a group of contiguous cells in a Spr

    My Alternative Codes****

    My thinking here:
    A few thought struck me

    _1 ) I found that in RL applications that it was sometimes better to treat the entire sheet as a "pseudo Array "Area" ". I do not have the experience to justify that theoretically, but a gut feel is that Excel sort of "starts" there in many cases. Once you start doing things, ( even relatively quick things like
    Arr() = ws.Range.Value ) , then extra things are done leading to size and speed limitations
    http://www.excelforum.com/excel-prog...t-range-2.html
    http://www.eileenslounge.com/viewtop...175343#p175343
    http://www.mrexcel.com/forum/excel-q...cations-2.html

    Only very occasionally have I found that the Cells variation can cause some problems
    http://www.eileenslounge.com/viewtop...177349#p177072
    _................
    ( _... _1b) I am wondering if some of my thinking here is contradicting a bit the following.. _..)

    _2) The above is separate to the idea of snb in taking in the "Range Array Area" , but I am wondering if taking in the "details" of the "Array Area", via a Range object could be advantageous.
    So where the .Index is concerned here, then I think modifying these things to take Cells, pseudo as an ultimate spreadsheet "Array Area" "range" , as the first argument seems interesting... ****
    Actually maybe point 1) and 2) are almost saying something similar.....my way of thinking is that Ricks code ( as far as VBA is concerned goes back and forth in one aspect: The range "capture" to an Array in the calling Code is reversed as I have a feeling form some of my timed experiments in the above links that in the use of .Index with an Array as the first argument "Grid / Area" means that somehow VBA "converts back" as it were to a range, as in principle the .Index is a Worksheets Function optimised to work on the "Cell" of Excel. ( This leads on to the next point that of the use of the Worksheets Function .Transpose.......!!!!

    _3) The final point in my thinking is all this Transposing back and forth..._...
    _...._. Hmm.. The .Transpose Function has a bad reputation, and does not appear to be improving with Excel versions. At least in the case of Arrays....!!!!
    http://excelmatters.com/2016/03/08/t...2013-and-2016/
    Again just a "gut" feeling from me is to avoid it as much as possible, at least in the case of Array work.
    Rick and snb are doing the Transpose often to get the correct Array "orientation" after using the spreadsheet Row(__:__) Function as a "Number argument taking" alternative to the "Letter argument taking" spreadsheet Column(__:__) Function ( Rick does once a number to letter version conversion, - so as to use [B]Column(__:__) where snb uses his Named range alternative ( 70 'clms() ) )

    _ 3b) A while back I wanted to get this niggly Colum letter thing behind me. I experimented with all existing methods, and developed an idea from shg to make a very quick Function based on Mathematics.
    http://www.excelforum.com/tips-and-t...ml#post4221359
    _ I suggest this will probably be incorporated into excel as a standard Function anyway . So I think it is worth having that Function to start with, always there, as it were, as if it was a standard Function.
    _ Make it a Public Function so that even in the "shorthand" version of Evaluate , _[__]_ it can be used ( This over comes the problem of not being able to use the shorthand version with VBA Functions as you cannot build a String _...
    http://www.mrexcel.com/forum/excel-q...s-dangers.html
    http://www.excelforum.com/excel-prog...ml#post4400666


    _.......
    ….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!!

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

    My Alternative Codes to .. ' Delete One Row From A 2D Excel Range Area ..... ;)

    So Alan Codes

    _1 ) First get the Column Letter Function out of the way... all explained and tested in detail here
    http://www.excelforum.com/tips-and-t...explained.html
    http://www.excelforum.com/developmen...ml#post4213980

    So just copy this code to a Normal Module and be done:
    Code:
    Public Function CL(ByVal lclm As Long) As String
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function
    Dann

    _1a) Eine Test Code for that Function

    Code:
    Sub TestCL() ' last Column XL 2007+ is 16384  XFD
    Dim strCL As String
    Let strCL = CL(16384): Debug.Print strCL
    Let strCL = Evaluate("CL(16384)"): Debug.Print strCL
    Let strCL = [CL(16384)]: Debug.Print strCL
    End Sub
    _1b) Check that it is "available in a spreadsheet" also thus:
    Type this in any Cell in any Worksheet in the Workbook which has the Module in which you copied the above Function to
    Using Excel 2007 32 bit
    Row\Col
    F
    3
    =CL(16384)



    After Hitting_....
    Enter
    _..............you should get this
    Row\Col
    F
    3
    XFD




    _...................._____________

    _2) Delete One Row From A 2D Excel Range Area
    Full code here:
    http://www.excelfox.com/forum/showth...=9828#post9828


    Brief Description'

    I decide to take the Range Area in as A range. This allows a convenient way to get the Worksheet Top left row and column coordinates of the Area, sRw and sClm, and its size, Rs x Cs.

    60 clms()
    Uses spreadsheet Column(__:__) Function directly through use of Column letter Function, CL(__) based on Area column co ordinates

    160 'rwsT()
    I am guessing that snb's " making a single string, replacing of an indicie with "nothing" " may be a bit quicker, than making two strings and concatenating them, so i do that way, but missing out all the transposing:
    250 Makes the 1 D "pseudo horizontal" Array directly through use spreadsheet Column(__:__) Function through use of Column letter Function, CL(__) based on Area row co ordinates
    280 Joins the elements of the 1 D "pseudo horizontal" Array to get the full indicies string.
    340 Replaces the row of that to be deleted with "nothing"
    370 Splits the string of final required indicies ( producing a 1 D "pseudo horizontal" Array ).

    380 I do the only transpose here but do it in a simple Loop. I hear a lot that this is quicker than the .Transpose Function, as I discussed previously

    440-480 As before, "Magic neat" code line is used to obtain final Array, then the Final Output Array arrOut() is assigned to the Function so that it will be returned at the Call line of a Calling routine when the Function Ends

    Just for completeness ( and a better comparison to the Rick and snb Codes ) , from Line 500, the code uses the .Transpose as an alternative.
    Final Codes from Alan

    Finally from all this comes 2 codes, the first still using a simple Loop for the last Transpose, the second is very similar to those from Rick and snb

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

    Some simplified codes are given in following Posts:
    ….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!!

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

    Simplified Codes based on last Full Code using Evaluate(" "):

    Simplified Codes based on last Full Code using
    Evaluate(“ “):
    I just give some simplified forms here. The main linked code was “opened up” and explained extensively in previous Posts and in the ‘Comments in that Full Code.


    Simplified With Loop for Transpose .... Evaluate(“ “)
    Code:
    Function FuRSHg(ByVal rngIn As Range, FoutRw As Long)
    370 Dim rwsS() As String: rwsS() = Strings$.Split(Replace(Strings$.Join(Evaluate("column(" & CL(rngIn.Row) & ":" & CL(rngIn.Row + (rngIn.Rows.Count - 1)) & ")"), " "), " " & FoutRw & "", "", 1, -1))
    390 Dim rwsT() As String: ReDim rwsT(0 To (UBound(rwsS())), 1 To 1) '
    400 Dim Cnt As Long: For Cnt = 0 To UBound(rwsS()): Let rwsT(Cnt, 1) = rwsS(Cnt): Next Cnt
    480 FuRSHg = Application.Index(Cells, rwsT(), Evaluate("column(" & CL(rngIn.Column) & ":" & CL(rngIn.Column + (rngIn.Columns.Count - 1)) & ")"))
    '
    End Function
    _.........................

    Simplified With .Transpose ...... Evaluate(“ “)
    Code:
    Function FuRSHgDotT(rngIn As Range, FoutRw As Long)
    550 FuRSHgDotT = Application.Index(Cells, Application.Transpose(Strings$.Split(Replace(Strings$.Join(Evaluate("column(" & CL(rngIn.Row) & ":" & CL(rngIn.Row + (rngIn.Rows.Count - 1)) & ")"), " "), " " & FoutRw & "", "", 1, -1))), Evaluate("column(" & CL(rngIn.Column) & ":" & CL(rngIn.Column + (rngIn.Columns.Count - 1)) & ")"))
    End Function
    _..............................................

    Here the Test Calling Code again:
    Code:
    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)
     Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
     Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()
     
     Let sp() = FuRSHgDotT(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()
     
    ' 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
    _..............................................
    Last edited by DocAElstein; 06-08-2016 at 04:18 AM.
    ….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. #16
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,429
    Rep Power
    10

    Alternative Codes using [ ] shorthand

    Alternative Codes using [ ] shorthand

    Two basic ideas are used here:

    _1) I found the “cheat” from snb more of a very neat “trick” or way you can to all intents and purpose do very close to doing vba Un Hard coded in [ ]- some more detailed background to that here
    http://www.excelforum.com/showthread...t=#post4404956
    http://www.excelforum.com/showthread...t=#post4404958
    so I have at the start
    1 Let rngIn.Name = "snRgNme"
    Which allows that to be used further in the program, replacing
    Range(“ “) Properties
    With formulas contain
    columns[snRgNme]

    _2 ) For the codes, some background is useful to go through to produce a number of variations and provide a “Library” of different alternatives for getting the various row and column limits ( Stop, Count and Stop row and column indicies )
    This is discussed here:
    http://www.excelforum.com/excel-prog...ml#post4400666
    And a resulting codes are here:
    http://www.excelfox.com/forum/showth...=9820#post9820
    and here:
    http://www.excelforum.com/showthread...51#post4404834
    http://www.excelforum.com/showthread...50#post4399150

    _......
    Unfortunately limitation were found in that for the code lines to return the start row and start column: It was found that :
    _an vba extra indicia
    (1), for the column
    And
    (1, 1 ), for the row was required after the evaluate.
    was required

    and also a
    _ extra VBA () was required after the [ ]
    version of Evaluate

    So
    a second code given here
    http://www.excelforum.com/showthread...04#post4406704
    and here
    http://www.excelfox.com/forum/showth...=9840#post9840
    over comes this.
    Code:
    550   Let sRw = Evaluate("=MIN(Row(snRgNme))"): Let sRw = [=MIN(Row(snRgNme))] '''Alternatives using Spreadsheet Functions to avoid having to VBA ()(  ) after the Evaluate
    560
    Code:
    302   Let sClm = Evaluate("=MIN(column(snRgNme))"): Let sClm = [=MIN(column(snRgNme))] 'Alternative using Spreadsheet Functions to avoid having to VBA ()(  ) after the Evaluate
    329   '

    _:____________-________

    The Full code with explaining ‘comments is found here:
    http://www.excelforum.com/showthread...40#post4406740
    and here
    http://www.excelfox.com/forum/showth...=9841#post9841

    One limitation to the simplification was found:
    There appears a Bug in VBA , such that some formulas used within VBA Evaluate will not work if a User Defined Function is used. It was found that in some cases our column Letter Function CL( ) did not work for no apparent reason.
    The code snippet from the Full code indicates that Lines 257 and 258 did not “work” meaning that a more complex line ( Line 260 ) was needed

    Code:
    200
    240 'Get Full row indicies convenientally ( As 1 D "pseudo horizontal" Array ) from Spreadsheet Column() Function
    250 Dim rws() As Variant: Let rws() = Evaluate("column(" & CL(sRw) & ":" & CL(sRw + (Rs - 1)) & ")") 'Original Line from first code using Evaluate(" ")
    251  Let vTemp = [CL(1)]: vTemp = [CL(MIN(Row(snRgNme)))] 'Both Return "A"
    252  vTemp = [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] 'Returns "J"
    254  Let rws() = [column(A:J)] ' Works
    257  'Let rws() = [column(CL(1):J)] ' Fails - Bug in Excel ! ? !
    258  'Let rws() = [column(CL(MIN(Row(snRgNme))):CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1))] ' Fails - Bug in Excel ! ? !
    260  Let rws() = Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")")
    270
    _.______________________

    In the next Posts simplified codes are given:

    One using a Loop to Transpose
    And
    One using .Dot Transpose
    Last edited by DocAElstein; 06-09-2016 at 12:02 AM.
    ….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. #17
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,429
    Rep Power
    10

    Alternative Codes simplified codes using [ ] shorthand

    Alternative Codes simplified codes using [ ] shorthand


    One using a Loop to Transpose
    Code:
    Function FuR_AlanShtHdshg(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
    1   Let rngIn.Name = "snRgNme"
    370 Dim rwsS() As String: Let rwsS() = Strings$.Split(Replace(Strings$.Join(Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")"), "|"), "|" & FoutRw & "", "", 1, -1), "|", -1)
    390 Dim rwsT() As String: ReDim rwsT(0 To (UBound(rwsS())), 1 To 1)
    400 Dim Cnt As Long: For Cnt = 0 To UBound(rwsS()): Let rwsT(Cnt, 1) = rwsS(Cnt): Next Cnt
    480 Let FuR_AlanShtHdshg = Application.Index(Cells, rwsT(), [column(snRgNme)])
    End Function

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

    One using .Dot Transpose
    Code:
    Function FuR_AlanShtHdDotTshg(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
    1   Let rngIn.Name = "snRgNme"
    550 Let FuR_AlanShtHdDotTshg = Application.Index(Cells, Application.Transpose(Strings$.Split(Replace(Strings$.Join(Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")"), "|"), "|" & FoutRw & "", "", 1, -1), "|", -1)), [column(snRgNme)])
    End Function

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

    Calling Code once again

    ' To Test Function, Type some arbitrary values in range A1:E10, step through Main 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
    Code:
    Sub Alan()
     Dim sp() As Variant
        'Dim DataArr() As Variant: Let DataArr() = Range("A1:E10").Value
    ' Let sp() = FuR_Alan(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()
     
    ' Let sp() = FuRSHg(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()
     
    ' Let sp() = FuRSHgDotT(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()
    
     Let sp() = FuR_AlanShtHd(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()
    
     Let sp() = FuR_AlanShtHdshg(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()
     
     Let sp() = FuR_AlanShtHdDotTshg(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
    _........

    And again required Column Letter Function
    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
    ….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. #18
    Junior Member xladept's Avatar
    Join Date
    May 2016
    Posts
    12
    Rep Power
    0
    Just to make the original post readable:

    Code:
    Function DeleteArrayRow(Arr As Variant, RowToDelete As Long) As Variant
      Dim Rws As Long, Cols As String
      Rws = UBound(Arr) - LBound(Arr)
    Cols = "A:" & Split(Columns(UBound(Arr, 2) - LBound(Arr, 2) + 1).Address(, 0), ":")(0)
      DeleteArrayRow = Application.index(Arr, _
      Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & _
      (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & _
      (RowToDelete + 1) & ":" & UBound(Arr) & ")"))))), Evaluate("COLUMN(" & Cols & ")"))
    End Function
    * I'd rep Rick for this if I could
    Last edited by xladept; 05-15-2018 at 10:09 PM.
    You can't do one thing.

    Orrin

  9. #19
    Junior Member
    Join Date
    Feb 2020
    Posts
    1
    Rep Power
    0

    Talking

    Quote Originally Posted by Rick Rothstein View Post
    I had assumed that avoiding the nested loop would be faster, but you are right... I just set up a test and they both run in approximately the same time... actually, the nested loop might even be a hair faster (it appeared to run about 0.005 seconds faster, on average, given my limited testing). For those wondering about the code for the nested loop version, this is what I used...
    Code:
    Sub Test2()
      Dim R As Long, C As Long, Idx As Long, RemoveRow As Long, Data_Array As Variant, ArrLessOne As Variant
      
      ' Seed the range with some data
      For Each Cell In Range("A1:AI1000")
        Cell.Value = Cell.Address(0, 0)
      Next
      
      Data_Array = Range("A1:AI1000")
      RemoveRow = 35
      ReDim ArrLessOne(1 To UBound(Data_Array, 1) - 1, 1 To UBound(Data_Array, 2))
      For R = 1 To UBound(Data_Array)
        If R <> RemoveRow Then
          Idx = Idx + 1
          For C = 1 To UBound(Data_Array, 2)
            ArrLessOne(Idx, C) = Data_Array(R, C)
          Next
        End If
      Next
      Range("AK1").Resize(UBound(ArrLessOne, 1), UBound(ArrLessOne, 2)) = ArrLessOne
    End Sub
    This just the solution I'm looking for , thank you Rick!

Similar Threads

  1. Replies: 6
    Last Post: 03-26-2014, 03:04 PM
  2. Replies: 1
    Last Post: 02-25-2014, 10:55 PM
  3. Delete Entire Row For All Empty Cells In Column
    By johnreid7477 in forum Excel Help
    Replies: 4
    Last Post: 06-15-2013, 05:50 AM
  4. Delte a specific column and does not delete the top row
    By jffryjsphbyn in forum Excel Help
    Replies: 1
    Last Post: 06-13-2013, 02:00 PM
  5. Replies: 4
    Last Post: 03-22-2013, 01:47 PM

Posting Permissions

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