Problem simplifed . . . can someone help me? Need target to have same attributes as source.

[pglufkin]

Posted something like this initially and no response. Will simplify what I need below:

I am trying to have the exact same type of text (font, color, boldness, italicizing, underlining, etc) in my target as I have in my source on a character by character basis. The procedure below works for color only. Is there a way I can modify this procedure to include all cell attributes for each character in my target? I looked at the Font properties and couldn't find what I needed. Maybe I need to do it in a totally different way? Thank you for any help you can give.

For Each cell In source
With cell
target.Characters(i, Len(.Value2)).Font.Color = .Font.Color
i = i + Len(.Value2) + Len(delim)
End With

 

[Norie]

What ranges are involved?

 

[pglufkin]

I have a total of a thousand or so cells of text, lined up in single file down a column. Part of my procedure goes and gets 3 - 10 or so cells of text at a time to concatenate them into one cell (see longer post referring to this problem with more code on what I am doing).

Each source cell has unique font properties for the text that is in that cell. When I concatenate the cells together into one cell, i want the individual characters of text in the concatenated cell to retain all the font attributes, size, color, underline, bold, italics, etc . . . of the multiple sources, and not just color.

Thank you.

P.S. Larger code below

Sub ConcatAndColorParts(target As Range, source As Range, Optional delim As String = " ")
    Dim cell As Range, v As Variant, i As Integer
     
    target.Value2 = ConcatRangeChars(source, delim)
    v = ""
    i = 1
    For Each cell In source
        With cell
            target.Characters(i, Len(.Value2)).Font.Color = .Font.Color
            i = i + Len(.Value2) + Len(delim)
        End With
    Next cell
    With Selection
        .HorizontalAlignment = xlJustify
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows(target.Row).EntireRow.AutoFit
    Application.SendKeys "{F2}"
    Application.SendKeys "{Backspace}"
    Application.SendKeys "{Enter}"
End Sub
 
Function ConcatRangeChars(charRange As Range, Optional delim As String = " ") As String
    Dim v As String, cell As Range
     
    Application.Volatile False
     
    v = ""
    For Each cell In charRange
        v = v & cell.Text & delim
    Next cell
    v = Left(v, Len(v) - Len(delim))
     
    ConcatRangeChars = v
End Function

 

[Norie]

Could you give some examples of the data?

Perhaps even upload a file somewhere like Box.net and post a link to it here.

 

[pglufkin]

Ok, thank you.

Uploaded file can be found at https://www.box.com/files/0/f/0/1/f_7192969404

 

[Norie]

There's something wrong with the link, when I click it I'm directed to login to my own Box.net account.

 

[pglufkin]

hmm, works for me, I am checking

 

[pglufkin]

This is the link they give me and it works for me >>> https://www.box.com/files/0/f/0/1/f_7192969404

I just started this account to give you the file.

Is there another way to get you the file?

 

[Norie]

Still going to my own account.

Where exactly did you get the link from?

Did you click Share next to the filename and copy the URL that appeared below?

I've only seen 'files' in the URL when I click on one of the files I've uploaded and then it appears in the browser address bar.

 

[pglufkin]

Ok, let's try this link, I set up a folder on my account.

https://www.box.com/s/3l096o59uiis74wr91wg