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
Bookmarks