Adding alt enter VBA code between strings of text

C

Cherhope

New Member
Joined
Dec 16, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Happy Friday everyone! I've been trying to arrive at the solution on my own but after several hours, I haven't found it so I need some help. I want to combine info in several cells into one cell. Some of the cells have info and some don't (it's random). I'd like each string of text in the one cell to be on separate lines. This is the code I have and it works to combine all the cells into one but I can't figure out how to and where to insert the VBA code for alt enter. Thanks!

Sub SpecialConcat()

Dim lastRow As Long

Dim wsData As Worksheet

'Where is the data?

Set wsData = Worksheets("Applicants")

Application.ScreenUpdating = False

With wsData

'Find where our data ends

lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

.Range("E2").EntireColumn.Insert

With .Range("E2:E" & lastRow)

.Formula = "=A2 & "" "" & B2 & "" "" & C2 & "" "" & D2 & "" "" "

.Copy

.PasteSpecial xlPasteValues

End With

.Range("A:D").Delete





End With



Application.ScreenUpdating = True



End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
maybe like this
VBA Code: 
Sub SpecialConcat()

    Dim wsData As Worksheet
    Dim lastRow As Long

'Where is the data?
Set wsData = Worksheets("Applicants")

Application.ScreenUpdating = False

With wsData
'Find where our data ends
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("E2").EntireColumn.Insert
    With .Range("E2:E" & lastRow)
        .WrapText = True
        .Formula = "=A2 & char(10) & B2 & char(10) & C2 & char(10) & D2"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    .Range("A:D").Delete
End With

Application.ScreenUpdating = True

End Sub
 
Upvote 0
Cherhope said:
Some of the cells have info and some don't (it's random).
Click to expand...
That gives me the impression that you want to ignore cells if they are blank. If that is so, give this version a try.
If it turns out that you want blank cells processed too (leaving blank lines in your results) then change the 1 in the TEXTJOIN function to 0

BTW, when posting vba code in the forum, please use the available code tags. My signature block below has more details.

VBA Code: 
Sub SpecialConcat_v2()
  Dim wsData As Worksheet
  Dim lastRow As Long

  Set wsData = Worksheets("Applicants")
  Application.ScreenUpdating = False
  With wsData
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Columns("E").Insert
    With .Range("E2:E" & lastRow)
      .WrapText = True
      .Formula = "=TEXTJOIN(CHAR(10),1,A2:D2)"
      .Value = .Value
    End With
    .Columns("A:D").Delete
  End With
  Application.ScreenUpdating = True
End Sub

One more check though. You are using column A to determine the last row but also saying some cells have no data.
Is it possible that the last row(s) could have data somewhere in columns B:D but nothing in column A?
If so, the code could miss processing some rows at the end and a code adjustment would be needed.
 
Last edited:
Upvote 0
Just to be contrarian and move away from formulas....

VBA Code: 
Sub SpecialConcat()
    Dim lastRow As Long
    Dim wsData As Worksheet
    Dim R As Range
    Dim I As Integer
    Dim S As String
    
    'Where is the data?
    Set wsData = Worksheets("Applicants")
    Application.ScreenUpdating = False
    With wsData
        'Find where our data ends
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("E2").EntireColumn.Insert
        
        For Each R In .Range("E2:E" & lastRow)
            S = ""
            For I = -4 To -1 Step 1
                If Trim(R.Offset(0, I).Value) <> "" Then
                    S = Replace(S & R.Offset(0, I).Value & Chr(10), Chr(10) & Chr(10), Chr(10))
                End If
            Next I
            If S <> "" Then
                R.Value = Left(S, Len(S) - 1)
            End If
        Next R
        
        .Range("A:D").Delete
    End With
    
    Application.ScreenUpdating = True

The only advantage to this method is that if some of the cells contain dates, you'll get the date as a date string instead of an excel date number, e.g. 11/12/2019 instead of 43781.
 
Upvote 0
NoSparks said:
maybe like this
VBA Code: 
Sub SpecialConcat()

    Dim wsData As Worksheet
    Dim lastRow As Long

'Where is the data?
Set wsData = Worksheets("Applicants")

Application.ScreenUpdating = False

With wsData
'Find where our data ends
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("E2").EntireColumn.Insert
    With .Range("E2:E" & lastRow)
        .WrapText = True
        .Formula = "=A2 & char(10) & B2 & char(10) & C2 & char(10) & D2"
        .Copy
        .PasteSpecial xlPasteValues
    End With
    .Range("A:D").Delete
End With

Application.ScreenUpdating = True

End Sub
Click to expand...
Thank-you very much this works!
 
Upvote 0
Peter_SSs said:
That gives me the impression that you want to ignore cells if they are blank. If that is so, give this version a try.
If it turns out that you want blank cells processed too (leaving blank lines in your results) then change the 1 in the TEXTJOIN function to 0

BTW, when posting vba code in the forum, please use the available code tags. My signature block below has more details.

VBA Code: 
Sub SpecialConcat_v2()
  Dim wsData As Worksheet
  Dim lastRow As Long

  Set wsData = Worksheets("Applicants")
  Application.ScreenUpdating = False
  With wsData
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Columns("E").Insert
    With .Range("E2:E" & lastRow)
      .WrapText = True
      .Formula = "=TEXTJOIN(CHAR(10),1,A2:D2)"
      .Value = .Value
    End With
    .Columns("A:D").Delete
  End With
  Application.ScreenUpdating = True
End Sub

One more check though. You are using column A to determine the last row but also saying some cells have no data.
Is it possible that the last row(s) could have data somewhere in columns B:D but nothing in column A?
If so, the code could miss processing some rows at the end and a code adjustment would be needed.
Click to expand...
Thank-you Peter. This works too. Re: your check question: it is possible that the last row of data could have data somewhere in columns B:D and nothing in A. I'm really new to VBA (plan to buy a book today to start learning it better). How would the code need to be adjusted?
 
Upvote 0
rlv01 said:
Just to be contrarian and move away from formulas....

VBA Code: 
Sub SpecialConcat()
    Dim lastRow As Long
    Dim wsData As Worksheet
    Dim R As Range
    Dim I As Integer
    Dim S As String
   
    'Where is the data?
    Set wsData = Worksheets("Applicants")
    Application.ScreenUpdating = False
    With wsData
        'Find where our data ends
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("E2").EntireColumn.Insert
       
        For Each R In .Range("E2:E" & lastRow)
            S = ""
            For I = -4 To -1 Step 1
                If Trim(R.Offset(0, I).Value) <> "" Then
                    S = Replace(S & R.Offset(0, I).Value & Chr(10), Chr(10) & Chr(10), Chr(10))
                End If
            Next I
            If S <> "" Then
                R.Value = Left(S, Len(S) - 1)
            End If
        Next R
       
        .Range("A:D").Delete
    End With
   
    Application.ScreenUpdating = True

The only advantage to this method is that if some of the cells contain dates, you'll get the date as a date string instead of an excel date number, e.g. 11/12/2019 instead of 43781.
Click to expand...
Thank-you for this! I have 2 more columns of data that will need this code because there are dates in those columns.
 
Upvote 0
Cherhope said:
Re: your check question: it is possible that the last row of data could have data somewhere in columns B:D and nothing in A. ... How would the code need to be adjusted?
Click to expand...
For my earlier code, the adjustment for that is this

Rich (BB code): 
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastRow = Columns("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For the situation with dates (or without), here is another option that should also do the job and requires less looping. It should also be faster (only relevant if your data is pretty large)

VBA Code: 
Sub SpecialConcat_v3()
  Dim wsData As Worksheet
  Dim a As Variant
  Dim i As Long

  Set wsData = Worksheets("Applicants")
  Application.ScreenUpdating = False
  With wsData
    With .Range("A2:D" & .Columns("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)
      .Replace What:="", Replacement:="#", LookAt:=xlWhole
      a = .Value
      .Replace What:="#", Replacement:="", LookAt:=xlWhole
    End With
    For i = 1 To UBound(a)
      a(i, 1) = Join(Filter(Application.Index(a, i, 0), "#", False), vbLf)
    Next i
    .Columns("E").Insert
    .Range("E2").Resize(UBound(a)).Value = a
    .Columns("A:D").Delete
  End With
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Peter_SSs said:
For my earlier code, the adjustment for that is this

Rich (BB code): 
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastRow = Columns("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For the situation with dates (or without), here is another option that should also do the job and requires less looping. It should also be faster (only relevant if your data is pretty large)

VBA Code: 
Sub SpecialConcat_v3()
  Dim wsData As Worksheet
  Dim a As Variant
  Dim i As Long

  Set wsData = Worksheets("Applicants")
  Application.ScreenUpdating = False
  With wsData
    With .Range("A2:D" & .Columns("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)
      .Replace What:="", Replacement:="#", LookAt:=xlWhole
      a = .Value
      .Replace What:="#", Replacement:="", LookAt:=xlWhole
    End With
    For i = 1 To UBound(a)
      a(i, 1) = Join(Filter(Application.Index(a, i, 0), "#", False), vbLf)
    Next i
    .Columns("E").Insert
    .Range("E2").Resize(UBound(a)).Value = a
    .Columns("A:D").Delete
  End With
  Application.ScreenUpdating = True
End Sub
Click to expand...
Thanks so much! It works! I really appreciate all the help. Have a great day!
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
153
harmless92
H
V
  • Question
Excel VBA - How to modify my code to include a command that prints data to PDF
Replies
1
Views
64
VanGirl
V
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
284
Alex Blakenburg
A
T
  • Question
How to show Msg if Record not found in table
Replies
3
Views
89
myall_blues
myall_blues
S
  • Question
VBA Code - Create Log sheet (Errorlog) in case VBA Macro condition is not met
Replies
1
Views
134
Tupe77
T

Forum statistics

Threads
1,214,970
Messages
6,122,514
Members
449,088
Latest member
RandomExceller01

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top