Editing cells with alt+enter

[danuk1976]

hi all

looking to edit single cells with rows(alt+enter) in them

eg a single cell with this in

Name1:ABC
Name2:ABCD
Name3:ABCDE
Name4:ABCDEF

change to/add lines

Name1:ABC
Name2:ABCD
Name2a:xxx
Name3:ABCDE
Name4:ABCDEF
Name4a:xxx


I recorded a macro,

ActiveCell.FormulaR1C1 = _        "Name1:ABC" & Chr(10) & "Name2:ABCD" & Chr(10) & "Name3:ABCDE" & Chr(10) & "[B][I]Name3a:ABCDE"[/I][/B] & Chr(10) & "Name4:ABCDEF" & Chr(10) & ""

but need something like

ActiveCell.FormulaR1C1 = _        Cell.row1.value & Chr(10) & Cell.row2.value & Chr(10) & Cell.row3.value& Chr(10) & "[B][I]Name3a:ABCDE"[/I][/B] & Chr(10) & Cell.row5.value& Chr(10) & ""

looking to isolate each row in cell if possible, thoughts/guidance and ideas appreciated

 

[Yongle]

The basics are to split the cell value into an array

myArray = Split(CellTxt, Chr(10))

and to get an individual line (arrays start at Zero - hence adding 1 to get line number)
Line 1 text is myArray(0)

I am not sure what exactly you are trying to achieve, but the VBA below...
- allows user to insert a line within the active cell
- and asks user to confirm before the cell value is amended
- the VBA is not as complicated as it looks (it is mostly message strings, and there are a few checks to avoid vba crashing)
- the lines doing the important stuff are blue

Run from the cell that you want to amend
- type in additional text
- enter a line number or leave as 999 to add as last line

Sub EachRowInCell()
    Dim TxtRows As Variant, RowCount As Integer, i As Integer
    Dim tmpArray As Variant
    Dim cel As Range, CellTxt As String, r As Integer
    Dim msg As String, tTxt As String, LineBreak As String
    Dim NewTxt As String, NewCellTxt As String
    [COLOR=#000080]LineBreak = Chr(10)[/COLOR]                                 'character for alt + enter
   [COLOR=#000080] Set cel = ActiveCell[/COLOR]
    [COLOR=#000080]CellTxt = cel.Value[/COLOR]
'does cell contain text
    If Len(CellTxt) = 0 Or cel.HasFormula Then GoTo TheEnd
'create array of individual lines
    [COLOR=#000080]TxtRows = Split(CellTxt, LineBreak)[/COLOR]
'build message string
    tTxt = "Cell text " & cel.Address(0, 0)             'tite string
    RowCount = UBound(TxtRows) + 1
    msg = "No of rows = " & RowCount & vbCr
    For i = 0 To UBound(TxtRows)
        msg = msg & vbCr & i + 1 & vbTab & TxtRows(i)
    Next i
'enter new next
    [COLOR=#000080]NewTxt = InputBox("Enter additional text")[/COLOR]
'where does it go?
    msg = msg & vbCr & vbCr & "ADDITIONAL TEXT:" & vbCr & NewTxt
    msg = msg & vbCr & vbCr & "Insert Text ABOVE which row ?" & vbCr & "999 = after last row"
    [COLOR=#000080]r = InputBox(msg, "EDIT " & tTxt, 999)[/COLOR]
'amend cell text
    Select Case r
        Case 1
            [COLOR=#000080]NewCellTxt = NewTxt & LineBreak & CellTxt[/COLOR]
        Case 999
            [COLOR=#000080]NewCellTxt = CellTxt & LineBreak & NewTxt[/COLOR]
        Case Else
            NewCellTxt = TxtRows(0)
[COLOR=#000080]            For i = 1 To r - 2
                NewCellTxt = NewCellTxt & LineBreak & TxtRows(i)
            Next i[/COLOR]
[COLOR=#000080]            NewCellTxt = NewCellTxt & LineBreak & NewTxt
            For i = (r - 1) To UBound(TxtRows)
                NewCellTxt = NewCellTxt & Chr(10) & TxtRows(i)
            Next i[/COLOR]
    End Select
'is user happy?
    msg = ""
    tmpArray = Split(NewCellTxt, LineBreak)
    For i = 0 To UBound(tmpArray)
        msg = msg & vbCr & tmpArray(i)
    Next
    If MsgBox(msg, vbYesNoCancel, "CONFIRM") = vbYes Then [COLOR=#000080]ActiveCell.Value = NewCellTxt[/COLOR]
Exit Sub
TheEnd:
MsgBox "Cell does not contain text"
End Sub

 

[Peter_SSs]

I'm also not exactly sure what you are trying to achieve, but here is another code that you could test.
Hopefully the comments in the code are explanation enough as to how to use it.

Sub Insert_Line()
  Dim pos As Long
  
  Const sNewLine As String = "Name2a:xxx" '<- New text to insert
  Const AfterLine As Long = 2             '<- Insert new text after this line in cell (Use 0 to insert at the start of the cell)
  
  With ActiveCell
    .Value = Replace(Replace(Trim(WorksheetFunction.Substitute(" " & Replace(Replace(.Value, " ", "@"), Chr(10), " ") & " ", " ", " " & sNewLine & " ", AfterLine + 1)), " ", Chr(10)), "@", " ")
  End With
End Sub

 

[danuk1976]

Thank you Peter & Yongle

Had a quick look and both look like great solutions that will surely benefit others !

basically if I sell 2 items with different amount of rows in the cell I need them to have the same number of rows,,,,, as this then makes further automation easier when it comes to splitting the rows out to adjacent columns ,,,,if that makes sense

 

[Peter_SSs]

if that makes sense

Not to me. If you want more help with it you would need to spell that out some more and give some examples of what you have, where and what you want, where.
Your initial post only mentioned one cell and one example.