Code:
Sub DeleteItemByIndexIn1DArraySHG1() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35980&p=279809#p279809 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15218&viewfull=1#post15218
Dim Indx As Long '
Let Indx = 1 ' 1 is for deleting the first element
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
Dim Pos1 As Long, Pos2 As Long
Let Pos1 = Evaluate("=Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))")
Debug.Print Pos1 ' 1
Let Pos2 = Evaluate("=Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))")
Debug.Print Pos2 ' 3
Dim LeftBit As String, RightBit As String
Let LeftBit = Left$("," & Joint, Pos1 - 1): Debug.Print LeftBit ' nothing there '
Let LeftBit = Evaluate("=Left(""," & Joint & """, " & Pos1 - 1 & ")"): Debug.Print LeftBit ' nothing there
Let RightBit = "," & Mid$("," & Joint & ",", Pos2 + 1): Debug.Print RightBit ' ,2,3,4,5,
' The MID spreadsheet function is less helpful since it must have the third argument ( in VBA MID the third length argument is optional
Let RightBit = "," & Right$("," & Joint & ",", Len(Joint) - (Pos2 - 2)): Debug.Print RightBit ' ,2,3,4,5, ' we don't want to take off the , and Joint is one less than Joint & "," so we take off in total 2 less
Let RightBit = Evaluate("="",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (" & Pos2 - 2 & "))")
Debug.Print RightBit ' ,2,3,4,5, '
Rem Joining the two and trimming odff the leading and trailing seperators
Dim JointedJoint As String
'Let JointedJoint = LeftBit & RightBit: Debug.Print JointedJoint ' ,2,3,4,5,
'Let JointedJoint = Evaluate("=""" & LeftBit & RightBit & """"): Debug.Print JointedJoint ' ,2,3,4,5,
Let JointedJoint = Evaluate("=" & """" & LeftBit & RightBit & """"): Debug.Print JointedJoint ' ,2,3,4,5,
Let JointedJoint = Evaluate("=" & """" & LeftBit & ",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (" & Pos2 - 2 & "))")
Debug.Print JointedJoint ' ,2,3,4,5,
Let JointedJoint = Evaluate("=Left(""," & Joint & """, " & Pos1 - 1 & ")&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (" & Pos2 - 2 & "))")
Debug.Print JointedJoint ' ,2,3,4,5,
Let JointedJoint = Evaluate("=Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")
Debug.Print JointedJoint ' ,2,3,4,5,
'Let JointedJoint = Mid(JointedJoint, 2, Len(JointedJoint) - 2): Debug.Print JointedJoint ' 2,3,4,5
'Debug.Print JointedJoint ' 2,3,4,5
'Let JointedJoint = Evaluate("=Mid(Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2)),2,Len(Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))))") ' Evaluate string has 355 characters so it wont work
'Debug.Print JointedJoint
Let JointedJoint = Mid(Evaluate("=Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Joint & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Joint & ","", Len(""" & Joint & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2)
Debug.Print JointedJoint ' 2,3,4,5
' replace Joint with Join(arr1D(), ",")
Let JointedJoint = Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2)
Debug.Print JointedJoint ' 2,3,4,5
' Get the string array back
Dim arr1DOut() As String
Let arr1DOut() = Split(JointedJoint, ",", -1, vbBinaryCompare): Let arr1DOut() = Split(JointedJoint, ",")
Let arr1DOut() = Split(Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2), ",")
' The spilt has returned string Elements, so we can't directly assign to the original array
' 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) ' https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%c3%a2%e2%82%ac%e2%80%9c-Application-Index
Let arr1D() = Application.Index(Split(Mid(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))"), 2, Len(Evaluate("=Left(""," & Join(arr1D(), ",") & """, Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx & "))-1)&"",""&Right(""," & Join(arr1D(), ",") & ","", Len(""" & Join(arr1D(), ",") & """) - (Find(""|"", Substitute(""," & Join(arr1D(), ",") & ","", "","", ""|"", " & Indx + 1 & "))-2))")) - 2), ","), 1, 0) ' Full workings: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=15218&viewfull=1#post15218
End Sub
Or ....
Bookmarks