Different format in same cell

[vivekshanghvi]

Hi

I am using this formula =O4 & CHAR(10) & P4 & CHAR(10) & Q4 to pick up data from three cells and merging...
Now I want to try and get that the data from cell O4 should be underlined
and data from cell P4 should be bold...

is it possible to do the same in the formula...i need this data in a single cell only as i need to create and print labels...

 

[gravanoc]

Hi

I am using this formula =O4 & CHAR(10) & P4 & CHAR(10) & Q4 to pick up data from three cells and merging...
Now I want to try and get that the data from cell O4 should be underlined
and data from cell P4 should be bold...

is it possible to do the same in the formula...i need this data in a single cell only as i need to create and print labels...

Unfortunately, to the best of my knowledge, that cannot be done to individual characters or words from a formula construct. TEXT allows you to use certain formats on individual parts, but not using underlines or bold. Your best bet would be a VBA solution that combines the individual parts into one phrase and to use the VBA to format the result using Range.Characters.

 

[gravanoc]

This will help you with your problem:

Sub FormatUnderline()
    Dim rngInput As Range
    Dim rngOutput As Range
    Dim str(0 To 2) As String
    Dim i As Long
   
    Set rngInput = ActiveSheet.Range("O4:Q4")
    Set rngOutput = ActiveSheet.Range("M4")
   
    For i = 0 To 2
        str(i) = rngInput.Cells(1, i + 1).Value
       
        If i = 0 Then
            rngOutput.Value = str(i)
        Else
            rngOutput.Value = rngOutput.Value & WorksheetFunction.Unichar(10) & str(i)
        End If
    Next i
   
    rngOutput.Characters(InStr(1, rngOutput.Value, str(0)), Len(str(0))).Font.Underline = True
    rngOutput.Characters(InStr(1, rngOutput.Value, str(1)), Len(str(1))).Font.Bold = True
    rngOutput.WrapText = True
End Sub

 

[vivekshanghvi]

tried it .. not working... Am i doing anythign wrong?

 

[gravanoc]

tried it .. not working... Am i doing anything wrong?

You may need to replace the M4 in the range I set above to whatever range you want the output to go into. Other than that, are you getting a specific error? Can you post a picture of the area in your workbook where this needs to work?

 

[vivekshanghvi]

hi

pls find the same

 

[RudRud]

Hi @vivekshanghvi , can you try this?

Right click sheet1 -> view code -> paste below code and run

Sub test()
Dim ss As Range

With Range("s:s")
.ClearFormats
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Columns.AutoFit
End With

For Each ss In Range("o4:o" & Cells(Rows.Count, "o").End(xlUp).Row)
    a = Len(ss.Value)
    b = Len(ss.Offset(0, 1).Value)
        
    With ss
       .Offset(0, 4).Value = .Value & vbLf & .Offset(0, 1).Value
        c = Len(.Offset(0, 4).Value) - b + 1
        .Offset(0, 4).Characters(1, a).Font.Underline = True
        .Offset(0, 4).Characters(c, b).Font.Bold = True
       
    End With
Next ss

End Sub

 

[vivekshanghvi]

View attachment 94820

Hi @vivekshanghvi , can you try this?

Right click sheet1 -> view code -> paste below code and run

Sub test()
Dim ss As Range

With Range("s:s")
.ClearFormats
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Columns.AutoFit
End With

For Each ss In Range("o4:o" & Cells(Rows.Count, "o").End(xlUp).Row)
    a = Len(ss.Value)
    b = Len(ss.Offset(0, 1).Value)
       
    With ss
       .Offset(0, 4).Value = .Value & vbLf & .Offset(0, 1).Value
        c = Len(.Offset(0, 4).Value) - b + 1
        .Offset(0, 4).Characters(1, a).Font.Underline = True
        .Offset(0, 4).Characters(c, b).Font.Bold = True
      
    End With
Next ss

End Sub

Hi

Thanks .. for your help but just 1 small addition I would require is that the address field also needs to be added .. can you pls help with tht,,

thanks in advance

 

[RudRud]

Hi

Thanks .. for your help but just 1 small addition I would require is that the address field also needs to be added .. can you pls help with tht,,

thanks in advance

Kindly give a shot, Is it taking slow to run the code? I will try to re-arrange my code if needed

Sub test()
Dim ss As Range

Application.ScreenUpdating = False


With Range("s:s")
.ClearFormats
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Columns.AutoFit
End With

For Each ss In Range("o4:o" & Cells(Rows.Count, "o").End(xlUp).Row)
    a = Len(ss.Value)
    b = Len(ss.Offset(0, 1).Value)
    c = Len(ss.Offset(0, 2).Value)
   
    With ss
       .Offset(0, 4).Value = .Value & vbLf & .Offset(0, 1).Value & vbLf & .Offset(0, 2).Value
        .Offset(0, 4).Characters(1, a).Font.Underline = True
        '.Offset(0, 4).Characters(a + 1, b + 1).Font.Bold = True
        .Offset(0, 4).Characters(a + 2, b + c + 1).Font.Bold = True
         .Offset(0, 4).Characters(a + b + 3, c).Font.Color = vbRed
    End With
Next ss

Application.ScreenUpdating = True

End Sub

 

[vivekshanghvi]

Kindly give a shot, Is it taking slow to run the code? I will try to re-arrange my code if needed

Sub test()
Dim ss As Range

Application.ScreenUpdating = False


With Range("s:s")
.ClearFormats
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Columns.AutoFit
End With

For Each ss In Range("o4:o" & Cells(Rows.Count, "o").End(xlUp).Row)
    a = Len(ss.Value)
    b = Len(ss.Offset(0, 1).Value)
    c = Len(ss.Offset(0, 2).Value)
  
    With ss
       .Offset(0, 4).Value = .Value & vbLf & .Offset(0, 1).Value & vbLf & .Offset(0, 2).Value
        .Offset(0, 4).Characters(1, a).Font.Underline = True
        '.Offset(0, 4).Characters(a + 1, b + 1).Font.Bold = True
        .Offset(0, 4).Characters(a + 2, b + c + 1).Font.Bold = True
         .Offset(0, 4).Characters(a + b + 3, c).Font.Color = vbRed
    End With
Next ss

Application.ScreenUpdating = True

End Sub

Worked perfectly..thank you for the help