Macro to Merge 2 Columns with Text Wrap and Text Formatting

lotus81

New Member
Joined
Jan 27, 2012
Messages
25
Hello,

I have 2 columns of data.
Column 1 is Song Title. I have this bold and a larger font.
Column 2 is the Artist in italics and a smaller font.

I would like to merge the columns together with a text wrap.
example:
Bad Blood
Taylor Swift

I have been using the Concatenate formula and it works great but it loses the text formatting. So I read up and found that I need a macro. But I don't even know where to start.

Please help.

Thank you in advance.
 
Last edited:

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

AnAnalyst

Well-known Member
Joined
Jul 10, 2007
Messages
536
Ok, here's a little stab at this for you.

Copy the code to a module in your workbook. The code assumes you are working on Sheet1 and that the Title is in column 1 (A), the artist is in column 2 (B), and the concatenation and formatting will go in column 3 (C). It also assumes that the data you want to process starts on row 2.

Code:
Sub ConcatAndFormat()
    ' Dimension the variables we will use in the process
    Dim lngRows As Long
    Dim intStartRow As Integer
    Dim intTitleColumn As Integer
    Dim intArtistColumn As Integer
    Dim intTitleAndArtistColumn As Integer
    Dim shtProcessing As Worksheet
    Dim objCell As Object
    Dim intTitleLength As Integer
    Dim intArtistLength As Integer
    Dim rngConcatAndFormat As Range
    ' Specify which sheet is being used
    Set shtProcessing = Sheet1
    ' Which row should the process start with?
    intStartRow = 2
    ' Which column is the song title in?
    intTitleColumn = 1
    ' Which column is the artist name in?
    intArtistColumn = 2
    ' Which column will we perform the join and formatting in?
    intTitleAndArtistColumn = 3
    ' Using the specified sheet ...
    With shtProcessing
        ' Calculate the row we should finish on
        lngRows = .Cells(.Rows.Count, 1).End(xlUp).Row
        ' Specify the range we will be writing to
        Set rngConcatAndFormat = .Cells(intStartRow, intTitleAndArtistColumn).Resize(lngRows - 1, 1)
        ' Iterate through the cells in the range
        For Each objCell In rngConcatAndFormat.Cells
            ' Concatenate the Title with a carriage return and the artist name
            objCell.Value = _
                .Cells(objCell.Row, intTitleColumn).Value & _
                Chr(10) & _
                .Cells(objCell.Row, intArtistColumn).Value
            ' Calculate the length of the title
            intTitleLength = Len(.Cells(objCell.Row, intTitleColumn).Value)
            ' Calculate the length of the artist name
            intArtistLength = Len(.Cells(objCell.Row, intArtistColumn).Value)
            ' Do the formatting ...
            With objCell
                ' ... of the title
                With .Characters(Start:=1, Length:=intTitleLength).Font
                    .Name = "Calibri"
                    .FontStyle = "Bold"
                    .Size = 12
                End With
                ' ... of the artist name
                With .Characters(Start:=intTitleLength + 2, Length:=intArtistLength).Font
                    .Name = "Calibri"
                    .FontStyle = "Italic"
                    .Size = 8
                End With
            End With
        Next objCell
        ' Adjust the column width to fit
        With .Cells(1, intTitleAndArtistColumn)
            .ColumnWidth = 80
            .EntireColumn.AutoFit
        End With
        ' Readjust the row heights
        With rngConcatAndFormat
            .EntireRow.AutoFit
        End With
    End With
    ' Set sheet and range objects to nothing
    Set shtProcessing = Nothing
    Set rngConcatAndFormat = Nothing
End Sub
 

Jobolobo

New Member
Joined
Mar 10, 2016
Messages
22
Hey lotus81,

Make sure you have a backup of your work before running this, this will make changes to your sheet and may be hard to reverse. It will however do as you asked. (Bold and text size increased for column A. And Italic and decreased size of text for B.)

Code:
[/COLOR]Sub Merge_Bold_Italic()
Dim txtCount1 As Integer
Dim txtCount2 As Integer
Dim txtBld1 As Range
Dim txtNml2 As Range
Dim rMax As Integer


rMax = Sheets("Sheet1").Range("A1").CurrentRegion.Rows.Count


For r = 1 To rMax
    txtCount1 = Sheets("Sheet1").Range("A" & r).Characters.Count
    txtCount2 = Sheets("Sheet1").Range("B" & r).Characters.Count
    
    Set txtBld1 = Sheets("Sheet1").Range("A" & r)
    Set txtNml2 = Sheets("Sheet1").Range("B" & r)
    
    With Sheets("Sheet1").Range("A" & r)
        .Value = txtBld1 & vbLf & txtNml2
        .WrapText = True
        With .Characters(Start:=1, Length:=txtCount1).Font
            .FontStyle = "Bold"
            .Size = 14
        End With
        With .Characters(Start:=txtCount1 + 2, Length:=txtCount2).Font
            .FontStyle = "Italic"
            .Size = 10
        End With
    End With
Next r
Range("B:B").EntireColumn.Delete
End Sub
[COLOR=#574123]

If you have headings you may need to alter the code before running. This works from A1 end of your data.

See how you go :)
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
Another option to try. This also has less individual character section processing so should be somewhat faster.
I've assumed data is in columns A:B and starts in row 2, with results to go to column C.

Rich (BB code):
Sub ConcatAndFormat()
  Dim c As Range
  
  Application.ScreenUpdating = False
  With Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    .WrapText = True
    .EntireColumn.ColumnWidth = 255
    .Value = Evaluate(Replace(Replace("if(len(#),#&char(10)&%,"""")", "#", .Offset(, -2).Address), "%", .Offset(, -1).Address))
    .Font.Italic = True
    .Font.Size = 8
    For Each c In Range(.Address)
      With c.Characters(1, Len(c.Offset(, -2).Value)).Font
        .Size = 12
        .Bold = True
        .Italic = False
      End With
    Next c
    .Columns.AutoFit
  End With
  Application.ScreenUpdating = True
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,123,336
Messages
5,601,023
Members
414,421
Latest member
tonybear1994

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
Top