Appendix Thread. App Index Rws() Clms() Majic code line Codings for other Threads, Tables etc.)

[DocAElstein]

Some extra notes for a few Posts
http://www.eileenslounge.com/viewtop...278892#p278892
https://www.myonlinetraininghub.com/...andling-in-vba
https://excelfox.com/forum/showthrea...GoRoT-N0Nula-1
https://excelfox.com/forum/showthrea...0559#post10559


hhfhhsfhhfaskh

[DocAElstein]

macro or this Post:
https://excelfox.com/forum/showthrea...ll=1#post15165

Sub ConcatWithStyles() '  https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687
Rem 0a save the formulas, and replace with values
Dim arrFormulas() As Variant
 Let arrFormulas() = Range("A1:F1").Formula
 Let Range("A1:F1").Value = Range("A1:F1").Value
  Dim X As Long, Cell As Range, Text As String, Position As Long
  Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1"))
  Position = 1
'  Application.ScreenUpdating = False
  For Each Cell In Range("A1:F1")
    With Range("A3")
      .Characters(Position, Len(Cell.Value)).Text = Cell.Characters(1, Len(Cell.Value)).Text
      For X = 1 To Len(Cell.Value)
        With .Characters(Position + X - 1, 1).Font
          .Name = Cell.Characters(X, 1).Font.Name
          .Size = Cell.Characters(X, 1).Font.Size
          .Bold = Cell.Characters(X, 1).Font.Bold
          .Italic = Cell.Characters(X, 1).Font.Italic
          .Underline = Cell.Characters(X, 1).Font.Underline
          .Color = Cell.Characters(X, 1).Font.Color
          .Strikethrough = Cell.Characters(X, 1).Font.Strikethrough
          .Subscript = Cell.Characters(X, 1).Font.Subscript
          .Superscript = Cell.Characters(X, 1).Font.Superscript
          .TintAndShade = Cell.Characters(X, 1).Font.TintAndShade
          .FontStyle = Cell.Characters(X, 1).Font.FontStyle
        End With
      Next
    End With
    Position = Position + Len(Cell.Value) + 1
  Next
  Application.ScreenUpdating = True
Rem 0b Put the formulas back
 Let Range("A1:F1").Formula = arrFormulas()
End Sub

[DocAElstein]

In support of these Thread answers:
' ' https://www.mrexcel.com/board/thread.../#post-3954687 https://excelfox.com/forum/showthrea...ll=1#post15170


It was seen ( https://excelfox.com/forum/showthrea...ll=1#post15168
https://excelfox.com/forum/showthrea...ll=1#post15167 ) when solving the formula in cell issue, that the cells containing the formula can only have a single style for all characters in the cell. So it’s not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells.

' '  https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687    https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15170&viewfull=1#post15170
Sub ConcatWithStyles3()
Dim RngSel As Range: Set RngSel = Selection: Set RngSel = Range("A1:F1")
Rem 0a save any formulas, and replace with values
Dim arrFormulas() As Variant
 Let arrFormulas() = RngSel.Formula ' Assuming wew select more than one cell, we will always be presented by  .Value  a 2 dimensional array, ( even if it is a single row or single column )  This codel line will  error if we are using a selection of one cell, since in that case  .Value  only returns a single value which VBA syntax does not allow to  be assigned to a dynmic array
Dim RwCnt As Long, ClmCnt As Long
'    For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._
'        For ClmCnt = 1 To RngSel.Columns.Count
'            If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' case a formula in cell
'             Let RngSel.Item(RwCnt, ClmCnt).Value = RngSel.Item(RwCnt, ClmCnt).Value ' replace the formula with its value
'            Else
'            End If
'        Next ClmCnt
'    Next RwCnt
Dim RwsCnt As Long, ClmsCnt As Long, Itm As Long, ItmCnt As Long
 Let ItmCnt = RngSel.Cells.Count
 Let RwsCnt = RngSel.Rows.Count: Let ClmsCnt = RngSel.Columns.Count
    For Itm = 1 To ItmCnt
        If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' case a formula in cell
         Let RngSel.Item(Itm).Value = RngSel.Item(Itm).Value ' replace the formula with its value
        Else
        End If
    Next Itm

Dim ExChr As Long, ACel As Range, TeExt As String, Position As Long
' Let Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1"))  ' This makes a teExt of spaces. The number of spaces is the sum of all the teExt in the cells + one less than the number of cells. This gives us enough characters for all the teExt and a space betweeen them
 Let Range("A3").Value = Space(Evaluate("=SUM(LEN(" & RngSel.Address & "))+COLUMNS(" & RngSel.Address & ")-1"))
 Let Position = 1
' Let Application.ScreenUpdating = False    ' adding this code line may speed the macro up a bit

 Let Itm = 0
  For Each ACel In RngSel
 Let Itm = Itm + 1
    With Range("A3") ' The range ( cell ) used for final output of concatenated cell text with styles
      'here in next code line we put the characters in...
      .Characters(Position, Len(ACel.Value)).Text = ACel.Value ' ACel.Characters(1, Len(ACel.Value)).Text  ' ACel.Value  This puts the charascters
     If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then  ' We only need to consider the cell style, since individual styles on characters are not possible in a cell with a formula in it
             '  ....it's not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells containing formulas
         With .Characters(Position, Len(ACel.Value)).Font  ' all the characters from the current cell in the final concatenated string
          .Name = ACel.Font.Name
          .Size = ACel.Font.Size
          .Bold = ACel.Font.Bold
          .Italic = ACel.Font.Italic
          .Underline = ACel.Font.Underline
          .Color = ACel.Font.Color
          .Strikethrough = ACel.Font.Strikethrough
          .Subscript = ACel.Font.Subscript
          .Superscript = ACel.Font.Superscript
          .TintAndShade = ACel.Font.TintAndShade
          .FontStyle = ACel.Font.FontStyle
        End With '
    
     Else ' we need to consider all characters in the cell
        For ExChr = 1 To Len(ACel.Value) ' We are looping for all the tExt Chraracters in the current cell text
        ' here in the next  With End With  section  the next character in the final concatenated string  is  given the styles  that it had in the cell it came from
          With .Characters(Position + ExChr - 1, 1).Font '  A single character in the final concatenated string
            .Name = ACel.Characters(ExChr, 1).Font.Name
            .Size = ACel.Characters(ExChr, 1).Font.Size
            .Bold = ACel.Characters(ExChr, 1).Font.Bold
            .Italic = ACel.Characters(ExChr, 1).Font.Italic
            .Underline = ACel.Characters(ExChr, 1).Font.Underline
            .Color = ACel.Characters(ExChr, 1).Font.Color
            .Strikethrough = ACel.Characters(ExChr, 1).Font.Strikethrough
            .Subscript = ACel.Characters(ExChr, 1).Font.Subscript
            .Superscript = ACel.Characters(ExChr, 1).Font.Superscript
            .TintAndShade = ACel.Characters(ExChr, 1).Font.TintAndShade
            .FontStyle = ACel.Characters(ExChr, 1).Font.FontStyle
          End With '
        Next ExChr
     End If
    End With
    Position = Position + Len(ACel.Value) + 1 ' This takes us to posiion at the end of the current cell text  +1  ( +1
  Next ACel
  Application.ScreenUpdating = True
Rem 0b Put the formulas back
    For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._
        For ClmCnt = 1 To RngSel.Columns.Count
            If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' ' case a formula was in cell
             Let RngSel.Item(RwCnt, ClmCnt).Formula = arrFormulas(RwCnt, ClmCnt) ' we put the formula back
            Else
            ' we didnt have a formula , so we do nothing to the cell - if we did then we would likely get just one style in the cell - a text with more than one style would revert to one single style throughout
            End If
        Next ClmCnt
    Next RwCnt
    

End Sub

[DocAElstein]

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:

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

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

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

[DocAElstein]

Coding for this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35980
and this post
https://eileenslounge.com/viewtopic....de06b5#p279861

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 ....

Sub DeleteItemByIndexIn1DArraySHG2() '   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)

 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

Some explanations in next post

[DocAElstein]

( In this example, Indx, is the Index number of the element that we want to remove starting from 1 – For the first element Indx must be given as 1

In Words , this is how the main code line works…( taking the example of wanting to remove the first element
My 1 D array , for example , {1,2,3,4,5} , is turned into a single text string, “1,2,3,4,5”. ( The separating thing, a comma in this case, is arbitrary. You should choose some character that is not likely to appear in any of your data.)
The next thing to do is add additional leading and trailing separating things ( commas in this example ) , so in the example it would then look like “,1,2,3,4,5,”

Now we use this sort of bit a lot.. Find(""|"", Substitute(""," & Join(arr1D(), ",") & """, "","", ""|"", " & Indx +1 & "))
Substitute is used to change the comma before the element you want to some other arbitrary separating thing.
So lets say we used a | and are wanting the first element ( Indx=1 ) removed. We then would have like
“|1,2,3,4,5,”
We then do a Find to get the position of that |
In other words,
The Substitute gives us this "|1,2,3,4,5,"
The Find looks for the | and gives us 1
Substitute is used again to change the comma after the element you want to some other arbitrary separating thing.
So lets say we used a | again. ( we are still wanting the first element) We then would have like
“,1|2,3,4,5,”
We then do a Find to get the position of that |
In other words,
The Substitute gives us this ",1|2,3,4,5,"
The Find looks for that | and gives us 3
Here is the last bit in close to the final code line:

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)

So we now know where the start and the end is of the element that we want to remove are
We can use this information to determine the string before, and to determine the string after, the element that we want to remove.
So we put those two strings together and that gives us the original string without the element that we want to remove.
Finally we Split that text back into an array

( Once again we will have all string elements out, regardless of what element types we have in our original array )

[DocAElstein]

post for later use..
http://i.imgur.com/dol9tfQ.jpg
http://i.imgur.com/Ucpj9pZ.jpg
http://i.imgur.com/mtLzChH.jpg
http://i.imgur.com/N2PbR0C.jpg
http://i.imgur.com/Nzfnk90.jpg
http://i.imgur.com/rnYpqNh.jpg
http://i.imgur.com/RODuXQl.jpg
http://i.imgur.com/zpWglC9.jpg


Hello
I tried it , second one, http://i.imgur.com/wL6hN1c.jpg
It did not work

http://i.imgur.com/Z7bl5cc.jpg
http://i.imgur.com/NG2ICxa.jpg
http://i.imgur.com/EpDQOXB.jpg

Alan

[DocAElstein]

post for later use-

[DocAElstein]

post for later use

[DocAElstein]

post for later use