Concat cells while retaining formats - Convert Macro into UDF (If Possibe)

[hrayani]

Hello Friends

I want to concatenate cells with its format as it is

I found this macro while searching on the net... Can this be converted into a UDF so that we can use a formula.

EDIT:
Also it does not allow to concat values in columns & does not seperates with a comma or anything

Sub MergeFormatCell()
'Updateby Extendoffice
    Dim xSRg As Range
    Dim xDRg As Range
    Dim xRgEachRow As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim I As Integer
    Dim xRgLen As Integer
    Dim xSRgRows As Integer
    Dim xAddress As String
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xSRg = Application.InputBox("Please select cell columns to concatenate:", "KuTools For Excel", xAddress, , , , , 8)
    If xSRg Is Nothing Then Exit Sub
    xSRgRows = xSRg.Rows.Count
    Set xDRg = Application.InputBox("Please select cells to output the result:", "KuTools For Excel", , , , , , 8)
    If xDRg Is Nothing Then Exit Sub
    Set xDRg = xDRg(1)
    For I = 1 To xSRgRows
        xRgLen = 1
        With xDRg.Offset(I - 1)
            .Value = vbNullString
            .ClearFormats
            Set xRgEachRow = xSRg(1).Offset(I - 1).Resize(1, xSRg.Columns.Count)
            For Each xRgEach In xRgEachRow
                .Value = .Value & Trim(xRgEach.Value) & " "
            Next
            For Each xRgEach In xRgEachRow
                xRgVal = xRgEach.Value
                With .Characters(xRgLen, Len(Trim(xRgVal))).Font
                .Name = xRgEach.Font.Name
                .FontStyle = xRgEach.Font.FontStyle
                .Size = xRgEach.Font.Size
                .Strikethrough = xRgEach.Font.Strikethrough
                .Superscript = xRgEach.Font.Superscript
                .Subscript = xRgEach.Font.Subscript
                .OutlineFont = xRgEach.Font.OutlineFont
                .Shadow = xRgEach.Font.Shadow
                .Underline = xRgEach.Font.Underline
                .ColorIndex = xRgEach.Font.ColorIndex
                End With
                xRgLen = xRgLen + Len(Trim(xRgVal)) + 1
            Next
        End With
    Next I
End Sub

Regards,

Humayun

 

[Rick Rothstein]

Any text placed in a cell from a formula (whether the functions used in the formula are built-in or UDFs) cannot have parts of that text formatted differently than the rest of the text. You can only do that with macros or event code. With that said, it may be possible to have a change event code procedure duplicate the functionality of your formulas and that event code procedure could do the formatting you want... from the user's standpoint, the actions of the event code will look the same as the actions that a formula produces. If that is something you would want to pursue, we need to know your formula, what cells it will be placed in and what formatting you want to do to the text. There is probably some other stuff we might need to know that will become apparent once we start coding the event procedure.

 

[hrayani]

Thanks Rick for the reply,

I would like to post a sample data to let you know what exactly I want.

I would want the C10 answer to be like this Alpha, Bravo, Peter, Humayun

Please have a look below... The original data as too big so I have prepared a dummy data to let you have an idea

Book1
	A	B	C	D	E	F
1	Ref #	Actual DATE	RESULT		Ref #	Names
2	527	20-May-20	Alpha		527	Alpha
3	528	21-May-20	Bravo		528	Bravo
4	530				530	Charlie
5	535				535	John
6	456	26-May-20	Peter		456	Peter
7	785				785	Rick
8	901				901	Tony
9	1012	29-May-20	Humayun		1012	Humayun
10		Required >	Alpha, Bravo, Peter, Humayun
Sheet1

Cell Formulas
Range	Formula
D4	D4	=IF(ISBLANK(B4),"",INDEX($E$2:$E$9,MATCH(A4,$F$2:$F$9,0)))
C2:C9	C2	=IF(B2<>"",INDEX(names,MATCH(A2,ref,0)),"")

Named Ranges
Name	Refers To	Cells
names	=Sheet1!$F$2:$F$9	D4, C2:C9
ref	=Sheet1!$E$2:$E$9	D4, C2:C9

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C2:C9	Expression	=TODAY()<B2	text	NO
C2:C9	Expression	=TODAY()>=B2	text	NO

 

[Rick Rothstein]

Most of that makes sense, but I have a couple of questions...

1) Since your example is a mock-up, I need to check... is all the information shown actually all on the same worksheet in your real workbook?

2) I am unclear how the single formula in cell D4 figures into, well, anything. For example, can you explain why it is part of your named ranges?

 

[hrayani]

1) Since your example is a mock-up, I need to check... is all the information shown actually all on the same worksheet in your real workbook?

In my real worksheet the actual dates & ref # are extracted (with formulas) from a different worksheet but the same workbook

2) I am unclear how the single formula in cell D4 figures into, well, anything. For example, can you explain why it is part of your named ranges?

Please ignore that... I was just testing the formula

 

[Rick Rothstein]

In my real worksheet the actual dates & ref # are extracted (with formulas) from a different worksheet but the same workbook

In order to write the code correctly, I need to know about different worksheets that are referenced in a formula, so you need to show us your actual formulas that you are actually using.

 

[hrayani]

Hi Rick,

Sorry for coming back late

These are the actual formulas.... in worksheet called MONTHLY CALENDAR

For Ref #
=IFERROR(AGGREGATE(15,6,orders_ref/((pp_sample_target_date=F6)*ISNA(MATCH(orders_ref,D6:D6,0))),1),"")

For Actual Dates
=IFERROR(IF(COUNTIFS(orders_ref,D7,pp_sample_actual_date,"")=0,INDEX(pp_sample_actual_date,MATCH(D7,orders_ref,0)),""),"")

For Result
=IF(D7<>"","PP SAMPLE - "&INDEX(orders_po,MATCH(D7,orders_ref,0))&" "&INDEX(orders_supplier,MATCH(D7,orders_ref,0))&" ("&INDEX(orders_quality,MATCH(D7,orders_ref,0))&")","")

Please note that these 3 formulas are for one category i.e. pp_sample but all the data is coming from one single worksheet (within the workbook) called DATABASE

I am working on 7 categories in total as of now. only the name ranges will be changed for the other categories.
Just to give you an example..... the other category is dpi

so for dpi the actual formulas will be

For For Ref #
=IFERROR(AGGREGATE(15,6,orders_ref/((dpi_target_date=F6)*ISNA(MATCH(orders_ref,D17:D17,0))),1),"")

For Actual Dates
=IFERROR(IF(COUNTIFS(orders_ref,D18,dpi_actual_date,"")=0,INDEX(dpi_actual_date,MATCH(D18,orders_ref,0)),""),"")

For Result
=IF(D18<>"","DPI - "&INDEX(orders_po,MATCH(D18,orders_ref,0))&" "&INDEX(orders_supplier,MATCH(D18,orders_ref,0))&" ("&INDEX(orders_quality,MATCH(D18,orders_ref,0))&")","")

Next all the data in the result columns are having conditional formats to turn green, red or remain black as it is

Please also note that target_date in this case is looking at date in CELL F6 which will not be the case for other columns

Kindly let me know if any other info is required

Regards,

Humayun