Coding for this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35980
and this post
https://eileenslounge.com/viewtopic....279798#p279798
Full version:
Code:
Sub Test() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35980
Dim Indx As Long ' the index of the element to be removed - for this example it can be chosen to be 0 or 1 or 2 or 3 or 4
Let Indx = 4
Dim arr1D() As Variant
Let arr1D() = Array(1, 2, 3, 4, 5)
Dim Joint As String
Let Joint = Join(arr1D(), "|"): Debug.Print Joint ' 1|2|3|4|5 ' - make sure you use a seperator that does not appear in any array element
Let Joint = "|" & Joint & "|": Debug.Print Joint ' |1|2|3|4|5| ' - needed so that I can get at the last and first element also
Dim CrackedJoint As String ' For cracked Joint
' I can use Application.WorksheetFunction.Substitute to pick out specific seperators , so I will replace the one before and after with some word like "Crack"
Let CrackedJoint = Application.WorksheetFunction.Substitute(Joint, "|", "Crack2", Indx + 2): Debug.Print CrackedJoint ' |1|2|3|4|5Crack2 ' ' https://excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings
Let CrackedJoint = Application.WorksheetFunction.Substitute(CrackedJoint, "|", "Crack1", Indx + 1): Debug.Print CrackedJoint ' |1|2|3|4Crack15Crack2
Dim Crack1 As Long, Crack2 As Long ' The positions of the cracks
Let Crack1 = InStr(1, CrackedJoint, "Crack1", vbBinaryCompare): Debug.Print Crack1 ' 9
Let Crack2 = InStr(1, CrackedJoint, "Crack2", vbBinaryCompare): Debug.Print Crack2 ' 16
Dim LeftBit As String, RightBit As String
Let LeftBit = Left$(CrackedJoint, Crack1 - 1): Debug.Print LeftBit ' |1|2|3|4
Let RightBit = "|" & Mid$(CrackedJoint, Crack2 + 6): Debug.Print RightBit ' |
Dim JointedJoint As String
Let JointedJoint = LeftBit & RightBit: Debug.Print JointedJoint ' |1|2|3|4|
Let JointedJoint = Mid(JointedJoint, 2, Len(JointedJoint) - 2): Debug.Print JointedJoint ' 1|2|3|4
Dim arr1DOut() As String
Let arr1DOut() = Split(JointedJoint, "|", -1, vbBinaryCompare)
' The above array is of element types of String , so we can't assign that to out original Variant type array. We can convert with
Let arr1D() = Application.Index(arr1DOut(), Evaluate("={1,1,1,1}"), Evaluate("={1,2,3,4}")) ' https://www.excelforum.com/tips-and-tutorials/758402-vba-working-with-areas-within-2d-arrays.html#post5408376
Let arr1D() = Application.Index(arr1DOut(), Evaluate("=Column(A:D)/Column(A:D)"), Evaluate("=Column(A:D)")) ' https://www.excelforum.com/excel-programming-vba-macros/1328703-copy-1-dim-array-to-and-2-dim-array.html#post5410028
Let arr1D() = Application.Index(arr1DOut(), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) '
' or
Let arr1D() = Application.Index(arr1DOut(), 1, 0) '
End Sub
“One liner ( almost ) “ versions
Code:
Sub Test2()
Dim Indx As Long
Let Indx = 4
Dim arr1D() As Variant: Let arr1D() = Array(1, 2, 3, 4, 5)
Let arr1D() = Application.Index(Split(Mid(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1), 2, Len(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), _
InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1)) - 2), "|"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) '
End Sub
Sub Test3()
Dim Indx As Long
Let Indx = 1
Dim arr1D() As Variant: Let arr1D() = Array(1, 2, 3, 4, 5)
Let arr1D() = Application.Index(Split(Mid(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1), 2, Len(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), _
InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(arr1D(), "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1)) - 2), "|"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(arr1D())).Address, "$", -1, vbBinaryCompare)(1) & ")")) '
End Sub
Function version
Code:
Sub testFunction()
Dim arr1D() As Variant: Let arr1D() = Array(1, "2", 3, 4, 5)
Let arr1D() = DeleteItem(arr1D(), 1)
End Sub
Function DeleteItem(ByVal Var As Variant, Indx As Long) As Variant
Let DeleteItem = Application.Index(Split(Mid(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1), 2, Len(Left$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), _
InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "@") - 1) & "|" & Mid$(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), InStr(Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute("|" & Join(Var, "|") & "|", "|", "#", Indx + 2), "|", "@", Indx + 1), "#") + 1)) - 2), "|"), Evaluate("=Column(A:" & Split(Cells(1, UBound(Var)).Address, "$", -1, vbBinaryCompare)(1) & ")/Column(A:" & Split(Cells(1, UBound(Var)).Address, "$", -1, vbBinaryCompare)(1) & ")"), Evaluate("=Column(A:" & Split(Cells(1, UBound(Var)).Address, "$", -1, vbBinaryCompare)(1) & ")")) '
End Function
Bookmarks