Delete One Row From A 2D Variant Array
Working in VBA with a 2D array in memory that was formed from a worksheet range is much faster than trying to work with the range directly on the worksheet itself. The way the array is formed is quite simple... just assign the range to a Variant variable. So, if you wanted to create an array in memory for range A1:M1000, you would (should) declare a Variant variable, for example...
Dim DataArr As Variant
and then assign the range to it...
DataArr = Range("A1:M1000")
Okay, with that brief introduction out of the way, I have seen on more than one occasion requests to be able to delete a single specified row from such a 2D Variant array. Finally, I decided to tackle the problem and see what I could come up with... this non-looping function is the result. The function accepts a 2-D Variant array and a row number for its arguments and it returns a 2-D Variant array with that row number removed.
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 |
Note the last line of code is quite long. Here is a macro to test the function with that creates the 2-D Variant array from the range A1:AI1000 (1000 rows by 35 columns), which the macro will fill with data for you, and outputs the array (with row 35 removed) returned by the function to the range starting at cell AK1. Note that the test macro seeds the given range with some data for you so you don't have to do that on your own.
Code:
Sub Test()
Dim Cell As Range, 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
ArrLessOne = DeleteArrayRow(Data_Array, RemoveRow)
Range("AK1").Resize(UBound(ArrLessOne, 1), UBound(ArrLessOne, 2)) = ArrLessOne
End Sub
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
Delete One Row From a ....... group of contiguous cells in a Spreadsheet
Delete One Row From a ....... group of contiguous cells in a Spreadsheet
'Coments on snb and Rick codes and further solutuons......
Hi,
I have learned a lot in the past from opening up these "One liner" codes from the likes of Rick and snb. These were no exceptions. I did some notes for my own use. I thought I would share them, in case any novices hitting the Thread might find them useful... I will try to keep it as brief as possible but there is a wealth of knowledge "hidden" in there.!! ;)
Very briefly first:
Rick's code:
Rick is working on an Array, what the Thread is about. ( He just happens to make that Array, ( arrIn() = DataArr or Arr ) in a typical way form a Spreadsheet Range "capture" through the .Value Property.
This .Value Property when applied to a Range for more than one cell returns a Field of Elements of Variant types. These can be assigned directly to a dynamic Array of variant Elements.
( That was Ricks comment more or less right at the start of the Thread. )
_ That Array is sent to the Function which returns the Modified Array. It has to be a Variant Element type as the used .Index method returns a Field on Variant Element Types ( for all but the one 0 argument slicing case ....._
https://usefulgyaan.wordpress.com/20...ication-index/
...._)
(_.......
In fact, both codes are similar and are basically using this sort of code line ( what I often refer to as a "Magic" or "neat Code line )
arrOut() = Application.Index(arrIn(), rwsT(), clms())
_....)
snb's Code
snb is working directly on the Range, ( rngIn = sn ) , - This..
Quote:
Originally Posted by
snb
... from array [A1:K20].....
...maybe is not quite right..... a "cheat"..****..but a lot more about that later
What he returns from
arrOut() = Application.Index( sn , rwsT(), clms())
is also an Array as .Index method returns a Field on Values of Variant Element Types ( for all but the one 0 argument slicing case ) . I will call this a "cheat" just as a convenient reference to the "way" he does it, not to be taken as literally, sort of, as actually after thinking about it, I decided to do something similar in my alternatives ****, which I present later here in this thread......
(_.... Edit: In fact , I found this "Cheat" and the associated use of a Name for that imputed Range fascinating and got quite side tracked with it !!
http://www.excelforum.com/excel-prog...acket-for.html _.......)
_.......
So...
My codes look massive compared to the original. Amongst other things I declare a lot of vba Variables.( And I use Option Explicit, to force me to do that ) In the final simplified codes the actual values set by the Variables are substituted into where the variables are used. So the need to declare them is gone_..............
_.................... You end up then with the final code lines or code line.
When I have finished I will give my attempt at an alternative ****.
_.....I "farmed out" my "opened up" codes here, ( to save cluttering up this thread ! )
Snb Code:
http://www.excelfox.com/forum/showth...ted=1#post9826
Rick code:
http://www.excelfox.com/forum/showth...=9824#post9824
_ If anyone is interested in my explanation then it might be worth copying the ranges shown below to a spare Worksheet, copying the codes to a spare Code Module and then following it through in Debug ( F8 ) mode as you work through my explanations.
_I tried to write the explanations and the opened up codes such that both codes and explanations run as much as possible in parallel
Use here of :.... arrOut() = Application.Index(arrIn(), rwsT(), clms())
So back to the codes given and discussed in this Thread, but again the use of
arrOut() = Application.Index(arrIn(), rwsT(), clms())
arrIn() we have ( as an Array by Rick or as a spreadsheet "Area" by snb )
All the "work" in the codes is to get the required rwsT() and clms() indices.
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 |
......
And to demo the Array returned by the Functions I will Paste it out here
Using Excel 2007 32 bit
| Row\Col |
M |
N |
O |
P |
Q |
|---|
| 16 |
|
|
|
|
|
| 17 |
0 |
10 |
20 |
30 |
40 |
| 18 |
2 |
12 |
22 |
32 |
42 |
| 19 |
4 |
14 |
24 |
34 |
44 |
| 20 |
6 |
16 |
26 |
36 |
46 |
| 21 |
10 |
20 |
30 |
40 |
50 |
| 22 |
12 |
22 |
32 |
42 |
52 |
| 23 |
14 |
24 |
34 |
44 |
54 |
| 24 |
16 |
26 |
36 |
46 |
56 |
| 25 |
18 |
28 |
38 |
48 |
58 |
| 26 |
|
|
|
|
|
| Sheet: NPueyoGyanArraySlicing |
So it follows that the main "work will be to get
rwsT() = { 1; 2; 3; 4; 6; 7; 8; 9; 10 } ' ( 2 Dimensional 1 "column" "Vertical" Array )
and
clms() = { 1, 2, 3, 4, 5 } ' ( 1 Dimension "pseudo Horizonal" Array )
_................................................. ...
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
_................................................. .
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
_.......
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
After Hitting_....
Enter
_..............you should get this
_...................._____________
_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:
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
_..............................................
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
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
