1

I'm looking to use a new column to combine 2 other columns with a line break in between the values. The second column uses text that is italicized and colored in RGB(226,239,218).

This macro needs to run through each row of the data set to perform this operation. If I was using a formula in a cell, it would look like =CONCATENATE(A1 & CHAR(10) & B1), but of course this does not preserve the formatting so it needs to be done in VBA.

To illustrate, cell A1 contains "Bobby" and cell B1 contains "Football Player", so cell C1 should look like:

Bobby
Football Player

(The 'Football Player' text should be colored)

My VBA knowledge is not very good, and I would definitely appreciate the help! Thanks!

Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
fouraces
  • 59
  • 1
  • 2
  • 9

2 Answers2

3

Okay, here you go. This should get you going:

Dim myRange As Range, c

Set myRange = Range("A1:A2")  'Set the range of the first column cells

For Each c In myRange.Cells
    If c.Value <> "" Then
        'Concatenate in 3rd column
        If c.Offset(0, 1).Value = "" Then
            c.Offset(0, 2).Value = c.Value
        Else            
            c.Offset(0, 2).Value = c.Value & Chr(10) & c.Offset(0, 1).Value
            'Apply formatting with preserving colors
            c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Color = c.Offset(0, 1).Font.Color
            c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Italic = c.Offset(0, 1).Font.Italic
            c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Bold = c.Offset(0, 1).Font.Bold
        End If
    End If
Next c
ashleedawg
  • 20,365
  • 9
  • 72
  • 105
ib11
  • 2,530
  • 3
  • 22
  • 55
  • Of course :-) But no need to be so savage... LOL. Any case I think I am still right on that he wants that specific RGB color. But we'll see... – ib11 May 06 '16 at 00:27
  • No one was savage. I downvoted because your first answer was poor, and reversed it (and upvoted as well) when it was improved. If you'd like, I can take back my upvote. :-) Even if the poster *did* want a specific color, this code is better because it will work with *any* color, which means it can be used for any color or style in a loop through a column. – Ken White May 06 '16 at 00:29
  • Sure, okay. What I meant that even if you tell me (without the downvote) I would have fixed it. That's all. We all want to help anyway, lighter methods work better therefore. Thanks for the upvote, yay! ;-) – ib11 May 06 '16 at 00:34
  • That did it, great work! I marked as accept and upvoted (but my votes don't display publicly yet. I'm going to delete some comments to clean up the thread. Thanks!! – fouraces May 06 '16 at 02:06
  • I would have done a pastespecial like using the format painter it would cover more. Paste:=xlPasteFormats. But still gets my vote – AndrewT May 06 '16 at 03:44
  • @AndrewT Thanks. Meaning vote up or down? :-) But I am intrigued of this idea. I was thinking of it too, but how do you paste the format on _part_ of a cell? – ib11 May 06 '16 at 03:47
  • Hi @ib11 pretty simple I did a macro record and got this as an output Selection.Copy Range("F3").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False – AndrewT May 06 '16 at 04:18
  • That didn't paste well but it is just a range.copy and a range.pastespecial with Paste:=xlPasteFormats – AndrewT May 06 '16 at 04:20
  • @AndrewT OK, thanks. But that was the problem the OP wanted to handle: to only copy _part_ of a range. See the original. It copies 2 separate cell into one and wants to preserve the formatting of the second one. I could not do this with `PasteSpecial`. – ib11 May 06 '16 at 05:01
  • Hey @ib11, is there any chance of adding a condition where if column A has a value, but column B is empty, the result in column C is the column A value but without the line break? Thanks! – fouraces May 15 '16 at 23:47
  • @fouraces Of course. It is though beyond the scope of your original question. So it is better to ask a new one and you can post the link here in the comments. However, I did this now for you, see edit above. – ib11 May 15 '16 at 23:55
  • @ib11, dynamite, works great! I added the next (and hopefully final step) to this same project, so if you're looking for additional answers/upvotes, check it out, as obviously your knowledge is excellent in this area: http://stackoverflow.com/questions/37245669/excel-vba-macro-to-group-rows-based-on-value – fouraces May 16 '16 at 02:00
0

Sub test()
    Dim cell   As Range
    Application.ScreenUpdating = False
    For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        Call concatenate_cells_formats(cell.Offset(, 2), cell.Resize(, 2))  'Destination column C, Source A:B
    Next cell
    Application.ScreenUpdating = True
End Sub

Sub concatenate_cells_formats(cell As Range, source As Range)

    Dim c      As Range
    Dim i      As Integer

    i = 1

    With cell
    
        .Value = vbNullString
        .ClearFormats

        For Each c In source
            If Len(c.Value) Then .Value = .Value & " " & Trim(c)
        Next c
        
        .Value = Trim(Mid(.Value, 2))

        For Each c In source
        
            With .Characters(Start:=i, Length:=Len(Trim(c))).Font
                .Name = c.Font.Name
                .FontStyle = c.Font.FontStyle
                .Size = c.Font.Size
                .Strikethrough = c.Font.Strikethrough
                .Superscript = c.Font.Superscript
                .Subscript = c.Font.Subscript
                .OutlineFont = c.Font.OutlineFont
                .Shadow = c.Font.Shadow
                .Underline = c.Font.Underline
                .ColorIndex = c.Font.ColorIndex
            End With
            
            .Characters(Start:=i + Len(c) + 1, Length:=1).Font.Size = 1
            i = i + Len(Trim(c)) + 1

        Next c

    End With

End Sub
  • Please explain more rather than just providing code with no explanation, so that the asker can understand how to do something like that in the future by themselves. – serakfalcon Nov 09 '17 at 06:21