CODEWITHSUNDEEP
vbaexcel
user7075507
user7075507

Reputation:

How can I Split a Cell by Carriage Return and Append Values?

I'm trying to split a cell by Carriage Return (3 cells to the left of my current cell) and concatenate 'AND' for all Carriage Returns, except the last one, and for the last one I want to concatenate 'YES'

Here is my VBA script.

CellSelect = ActiveCell.Value
CellAddress = ActiveCell.Address
Dim splitVals As Variant
arrLines = Split(Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -3).Value, Chr(10))

    For Each strLine In arrLines
        Debug.Print strLine
        Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value = strLine & Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -2).Value
    Next

End If

Here is a screen shot of my setup. Basically, I'm trying to concatenate what's in the 1st, 2nd, and 3rd cells, into the 4th cell.

enter image description here

I think I'm close. I just can't seem to get it working correctly.

Thanks!!

Upvotes: 1

Views: 326

Answers (3)

cyboashu
cyboashu

Reputation: 10433

Just Replace with StrReverse will workfine. No For or Array required.

Sub test()

   Dim strOrig  As String
   Dim strNew   As String


   'strOrig = Sheet1.Cells(1)
   strOrig = "a " & Chr(10) & " b " & Chr(10) & " c " & Chr(10)
   Debug.Print strOrig

'        a
'        b
'        c

   strNew = StrReverse(Replace(StrReverse(strOrig), Chr(10), StrReverse("YES"), , 1))
   strNew = Replace(strNew, Chr(10), "AND")

   Debug.Print strNew

   'a AND b AND c YES

End Sub

Upvotes: 2

Robin Mackenzie
Robin Mackenzie

Reputation: 19319

You can try this: split the cell value to an array and then add AND or YES if it is the last item in the array:

Option Explicit

Sub Test()
    Dim rng As Range
    Set rng = Sheet1.Range("A1")
    AppendAndYes rng
End Sub

Sub AppendAndYes(rngCell As Range)

    Dim varItems As Variant
    Dim lngIndex As Long

    'get lines by splitting on line feed
    varItems = Split(rngCell.Value, vbLf, -1, vbBinaryCompare)

    'loop through and add AND or YES
    For lngIndex = LBound(varItems) To UBound(varItems)
        If lngIndex < UBound(varItems) Then
            varItems(lngIndex) = varItems(lngIndex) & " AND"
        Else
            varItems(lngIndex) = varItems(lngIndex) & " YES"
        End If
    Next lngIndex

    'update cell value
    rngCell.Value = Join(varItems, vbLf)

End Sub

Upvotes: 0

user7075507
user7075507

Reputation:

I got it working with this.

CellSelect = ActiveCell.Value
CellAddress = ActiveCell.Address
Dim splitVals As Variant
arrLines = Split(Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -3).Value, Chr(10))
arrLinesLast = UBound(arrLines)
    For Each strLine In arrLines
        If arrLinesLast <> 1 Then
            If arrLinesLast = 0 Then Exit Sub
            Debug.Print strLine
            Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value = Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value & " " & strLine & " " & Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -2).Value & Chr(10)
                arrLinesLast = arrLinesLast - 1
                Else
                Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value = Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, 0).Value & " " & strLine & " " & Sheets("CP (POS) Tasklist").Range(CellAddress).Offset(0, -1).Value
                arrLinesLast = arrLinesLast - 1
        End If
    Next

Upvotes: 1

Related Questions