Using VBA table: split cell if string to be inserted has a + sign in it

Question

I'm a VB user who has to go backwards and try to make VBA code work in Word. I have a .dotm file that has tables and data that the userform "vacuums" up on initialize. The client launches their own document and can insert "starter tables" copied from my .dotm. In those tables, the user goes to a blank cell and chooses a button from userform to insert text into that cell. If the text associated with the button has a plus sign, I want to split the cell the user is in, and split the string so that one piece is in "original" cell, the other piece in the newly-created-via-split cell. I have the code for splitting the user-chosen cell, but I'm having trouble referring to the original cell and the newly created cell. Here's the code, adapted from something similar for splitting:

Public Sub SelectionInfo(ByVal RememberMyText As String)
     '
    Dim iSelectionRowEnd As Integer
    Dim iSelectionRowStart As Integer
    Dim iSelectionColumnEnd As Integer
    Dim iSelectionColumnStart As Integer
    Dim lngStart As Long
    Dim lngEnd As Long
     Dim numberOfColumnsInCurrentTable As Integer
        Dim currentTableIndex As Integer

     ' Check if Selection IS in a table
     ' if not, exit Sub after message
    If Selection.Information(wdWithInTable) = False Then
        MsgBox "Selection is not in a table.  Exiting macro."
    Else

        currentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
        NumberOfColumns = ActiveDocument.Tables(currentTableIndex).Columns.Count
        MsgBox ("Current table is # " & currentTableIndex)


        lngStart = Selection.Range.Start
        lngEnd = Selection.Range.End

         ' get the numbers for the END of the selection range
        iSelectionRowEnd = Selection.Information(wdEndOfRangeRowNumber)
        iSelectionColumnEnd = Selection.Information(wdEndOfRangeColumnNumber)

         ' collapse the selection range
        Selection.Collapse Direction:=wdCollapseStart

         ' get the numbers for the END of the selection range
         ' now of course the START of the previous selection
        iSelectionRowStart = Selection.Information(wdEndOfRangeRowNumber)
        iSelectionColumnStart = Selection.Information(wdEndOfRangeColumnNumber)

         ' RESELECT the same range
        Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - lngStart

         ' display the range of cells covered by the selection
        MsgBox "The selection covers " & Selection.Cells.Count & " cells, from Cell(" & _
        iSelectionRowStart & "," & iSelectionColumnStart & ") to Cell(" & _
        iSelectionRowEnd & "," & iSelectionColumnEnd & ")."

        Dim counter As Integer
        counter = 0

        For j = 1 To Len(RememberMyText)
            If Mid(RememberMyText, j, 1) = "+" Or Mid(RememberMyText, j, 1) = "-" Then
                counter = counter + 1
            End If
        Next j
        If counter > 0 Then
            MsgBox ("There were " & counter & " symbols..")
            'ActiveDocument.SelectionTables(1).Cell(iSelectionRowStart, iSelectionColumnStart).Split Numrows:=1, NumColumns:=2, MergeBeforeSplit:=False

            'ActiveDocument.SelectionTables(1).Cell(iSelectionRowStart, iSelectionColumnStart).Range.Select
            If counter = 1 Then
            Selection.Cells.Split Numrows:=1, NumColumns:=2, Mergebeforesplit:=True 'False
            'now split the text and redistribute it into the two cells, same row, different column for other half of original string

            Dim Result() As String
            Result() = Split(RememberMyText)
            Dim rng As Range
            rng = ActiveDocument.Tables(currentTableIndex).Rows(iSelectionRowStart).Cells(iSelectionColumnStart).Range
            'also tried: rng = ActiveDocument.Tables(currentTableIndex).Cells(iSelectionRowStart,iSelectionColumnStart).Range
            Selection.TypeText ("")
            Selection.TypeText (Result(0))
            rng = ActiveDocument.Tables(currentTableIndex).Rows(iSelectionRowStart).Cells(iSelectionColumnStart + 1).Range
            'also tried: rng = ActiveDocument.Tables(currentTableIndex).Cells(iselectionRowStart,iSelectionColumnStart + 1).Range
            Selection.TypeText (Result(1))


            ElseIf counter = 2 Then
            Selection.Cells.Split Numrows:=1, NumColumns:=3, Mergebeforesplit:=True 'False ' also switched true and false
'still working on this one, it would be the same issue.
            End If


        End If


    End If
End Sub

The cell splits OK, leaving the original text in the one cell, and the newly created cell is empty. I just want to "re-do" those two cells (or re-do three cells if there are two plus signs in the original string) I'm just an intermediate-level person; any help greatly appreciated. Thanks

Answer 1

Try:

Public Sub SelectionInfo(ByVal RememberMyText As String)
Application.ScreenUpdating = False
Dim Rng As Range, StrAddr As String, i As Long, j As Long
With Selection
  Set Rng = .Range
  ' Check if Selection IS in a table. If not, exit after message
  If .Information(wdWithInTable) = True Then
    StrAddr = "The selected cell"
    If .Cells.Count = 1 Then
      StrAddr = StrAddr & " address is: "
    Else
      StrAddr = StrAddr & "s span: "
    End If
    StrAddr = StrAddr & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex
    If .Cells.Count > 1 Then
      StrAddr = StrAddr & ":" & ColAddr(.Characters.Last.Cells(1).ColumnIndex) & _
        .Characters.Last.Cells(1).RowIndex
    End If
    StrAddr = StrAddr & " of Table: " & _
      ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
    MsgBox StrAddr
    RememberMyText = Replace(Replace(RememberMyText, "+", "¶"), "-", "¶")
    j = UBound(Split(RememberMyText, "?"))
    If j > 0 Then
      'create new cells
      Rng.Cells(1).Split Numrows:=1, NumColumns:=j + 1
    End If
    'now split the text and redistribute it into the cells
    For i = 0 To j
      Rng.Cells(i + 1).Range.Text = Split(RememberMyText, "¶")(i)
    Next
  Else
      MsgBox "Selection is not in a table.  Exiting macro."
  End If
End With
Application.ScreenUpdating = True
End Sub

Function ColAddr(i As Long) As String
If i > 26 Then
  ColAddr = Chr(64 + Int(i / 26)) & Chr(64 + (i Mod 26))
Else
  ColAddr = Chr(64 + i)
End If
End Function