Preserving formatting (Excel 2002)

Topic

New Reply

I wanted to concatenate two huge columns of text data into a single column. In each column I had different formatting and one cell had a different colour font. Try as I might the formula result was always the bog standard Arial 10 in basic black.

I tried quite a few things such as styles, conditional formatting and the like. I even search for a function that might tell Excel to keep its original formatting. No luck. The format painter does not work with cells having multiplel formatting. The copy command does though.

I know that I can manually go into a cell and format different sections of text but in my case this would be too tedious..

Does anybody know if it’s possile to do what I want easily?

TIA
Brian

Reply | Quote

Replies

I do not think that multiple formatting can be copied from a single cell or indeed applied to a style. To do what you want requires some VBA and the following code does what I thnk you want. Select the concatenated range and run the code, but be warned it replaces formulas with actual values. Further it only works on font formatting. Also assumed is that the columns are adjacent, eg. A, B and C with C hold the concatenated values.

Sub MultiFormat
Application.ScreenUpdating = False
Dim oCell As Range, intPos As Integer
Selection.Offset(0, -1).Copy
Selection.PasteSpecial Paste:=xlPasteFormats
Selection.Copy: Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
For Each oCell In Selection
intPos = Len(oCell.Offset(0, -2))
With oCell
With .Characters(Start:=1, Length:=intPos).Font
.Bold = .Offset(0, -2).Font.Bold = True
.Italic = .Offset(0, -2).Font.Italic = True
.Size = .Offset(0, -2).Font.Size
.ColorIndex = .Offset(0, -2).Font.ColorIndex
End With
End With
Next
Application.ScreenUpdating = True
End Sub

You can omit any lines applying properties you are not interested in such as Bold, Italic etc.

Andrew C

Reply | Quote

Andrew
A question
I see you’ve coded lines with a boolean test like .Bold = .Offset(0, -2).Font.Bold = True

I tried similar code without the boolean and always got false but don’t understand why.
Why doesn’t
.Bold = .Offset(0, -2).Font.Bold
also work given .Bold is a boolean in its own right?
Andrew O

(Another method which also works to solve the original problem is to simply cut and paste special the range into Word as RTF, then turn the resulting table into text and cut and paste it back into Excel.
It manages to preserve even embedded character formats, but also loses formulae.)

Reply | Quote

Andrew,

Good question and I too think it should work, but in this case it gives a Run Time error, (object doesn’t support this property or method).

Actually something like ActiveCell.Font.Bold = ActiveCell.Offset(0, -2).Font.Bold works fine, that is applying the Bold property of one cell to another.

However it seems Excell or VBA is not too happy applying the bold property of a cell to the bold property of a collection of characters.
Perhaps somebody else can give a better explanation.

Andrew C

Reply | Quote

Many thanks for the reply.

I pasted your code into a VBA module, compiled it but it failed to work. It generates a 438 error (object does not support this property or method) and debugging stops at the .Bold = .Offset(0, -2).Font.Bold = True
Unfortunately I don’t use VBA enough to be able to suss out what is happening. Perhaps I am doing something silly?

Brian

Reply | Quote

Sorry Brian,

I was silly and posted an incorrect version in error :

The following worked ok

Sub MultiFormat()
Application.ScreenUpdating = False
Dim oCell As Range, intPos As Integer
Selection.Offset(0, -1).Copy
Selection.PasteSpecial Paste:=xlPasteFormats
Selection.Copy: Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
For Each oCell In Selection
intPos = Len(oCell.Offset(0, -2))
With oCell.Characters(Start:=1, Length:=intPos).Font
.Bold = oCell.Offset(0, -2).Font.Bold = True
.Italic = oCell.Offset(0, -2).Font.Italic = True
.Size = oCell.Offset(0, -2).Font.Size
.ColorIndex = oCell.Offset(0, -2).Font.ColorIndex
End With
Next
Application.ScreenUpdating = True
End Sub

Andrew C

Reply | Quote

Try this code. Select 3 cells. The first and second are combined into the third with the formatting. I thought of it as Left, center, and right, but it also would work with top, middle, and bottom. SInce the “cells” property is NOT picky about orientation.

This could be modified relatively easily to add 3 concatenates to the far right(4th cell) without too much additional programming.

It could be modified relatively simply to do it completely generically and loop through all the cells and just combine them into the last one.

Steve

Option Explicit
Sub CombLeftCenterToRightCell()
    
    If Selection.Count  3 Then
        MsgBox ("You must select 3 Cells:" & _
            vbCrLf & "Left and Center are combined" & _
            vbCrLf & "(with FORMATTING) into the RIGHT Cell")
    End If
    
    Dim iLeftLength As Integer
    Dim iCenterLength As Integer
    Dim rLeft As Range
    Dim rCenter As Range
    Dim rRight As Range
    Set rLeft = Selection.Cells(1)
    Set rCenter = Selection.Cells(2)
    Set rRight = Selection.Cells(3)
    
    iLeftLength = Len(rLeft.Value)
    iCenterLength = Len(rCenter.Value)
    rRight.Value = rLeft.Value & rCenter.Value
    
    With rRight.Characters(Start:=1, Length:=iLeftLength).Font
        .Name = rLeft.Font.Name
        .FontStyle = rLeft.Font.FontStyle
        .Size = rLeft.Font.Size
        .Strikethrough = rLeft.Font.Strikethrough
        .Superscript = rLeft.Font.Superscript
        .Subscript = rLeft.Font.Subscript
        .OutlineFont = rLeft.Font.OutlineFont
        .Shadow = rLeft.Font.Shadow
        .Underline = rLeft.Font.Underline
        .ColorIndex = rLeft.Font.ColorIndex
    End With
    
    With rRight.Characters(Start:=iLeftLength + 1, _
        Length:=iLeftLength + iCenterLength).Font
        .Name = rCenter.Font.Name
        .FontStyle = rCenter.Font.FontStyle
        .Size = rCenter.Font.Size
        .Strikethrough = rCenter.Font.Strikethrough
        .Superscript = rCenter.Font.Superscript
        .Subscript = rCenter.Font.Subscript
        .OutlineFont = rCenter.Font.OutlineFont
        .Shadow = rCenter.Font.Shadow
        .Underline = rCenter.Font.Underline
        .ColorIndex = rCenter.Font.ColorIndex
    End With
End Sub

Reply | Quote

Many thanks for your reply.

I tried your code and it works beautifully and does exactly what I wanted it to do. As you say I will now have to write a litle routine to loop it through all the other cells in the range.

Thanks again

Brian

Reply | Quote

I had a chance to look at it again. This one is more generic.

Highlight all the rows and all the columns (it puts the concatenation in the last col of each row selected.) It will combine all the selected columns, but the last one (which has the combined). It also looks at each character in the cells to format character by character rather than cell by cell (in case some characters in a cell were formatted special.

Steve

Sub CombCopyFormat()
Application.ScreenUpdating = False
If Selection.Columns.Count > 1 Then
    Dim rCell As Range
    Dim rCellFont As Font
    Dim rLastCell As Range
    Dim iCol As Integer
    Dim iCols As Integer
    Dim iRow As Integer
    Dim x As Integer
    Dim iPos As Integer
    
    iCols = Selection.Columns.Count
    
    For iRow = 1 To Selection.Rows.Count
        Set rLastCell = Selection.Cells(iRow, iCols)
        rLastCell.Value = ""
        For iCol = 1 To iCols - 1
            Set rCell = Selection.Cells(iRow, iCol)
            rLastCell.Value = rLastCell.Value & rCell.Value
        Next iCol
        
        iPos = 1
        For iCol = 1 To iCols - 1
            Set rCell = Selection.Cells(iRow, iCol)
            For x = 1 To Len(rCell)
                Set rCellFont = Selection.Cells(iRow, iCol). _
                    Characters(start:=x, Length:=1).Font
                With rLastCell.Characters(start:=iPos, Length:=1).Font
                    .Name = rCellFont.Name
                    .FontStyle = rCellFont.FontStyle
                    .Size = rCellFont.Size
                    .Strikethrough = rCellFont.Strikethrough
                    .Superscript = rCellFont.Superscript
                    .Subscript = rCellFont.Subscript
                    .OutlineFont = rCellFont.OutlineFont
                    .Shadow = rCellFont.Shadow
                    .Underline = rCellFont.Underline
                    .ColorIndex = rCellFont.ColorIndex
                End With
                iPos = iPos + 1
            Next x
        Next iCol
    Next iRow
End If
Application.ScreenUpdating = True
End Sub

Reply | Quote

Many thanks to all who helped out. I now have been able to achieve my task and have saved hours of sweat & toil.

This excercise has also revived my interest in code!
WLTL
Brian

Reply | Quote