Is it possible to copy information from mutiple cells, to one cell and keep the formatting? as an example, I have A1=Hello (Green, bold font), A2, World (red font)
Want to have B2=Hello World (with words in different color).
Looking for a solution in Google Sheets, but as an alternative, Excel would also work
For example my activecell has word "bankeris", so I made first 3 letters one color and another 3 letters with other color. This code is via "Macro recording". So copy/paste will do same.
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=4, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.ThemeFont = xlThemeFontMinor
End With
Thank you Bankeris.
The solution I need is a bit different - the number of characters will be variable, I purely need to copy the format from the original cell.
To give a big picture - there is a table with approx 8 columns, each column will have its color, but the numbers of characters in the cell will be different. The goal if to create a sentence which will include information from the specified row...but the format of each word in the sentence needs to be the same as in the original table.
Potentially, this solution could be used, but the number of chars for each color would need to be identified from te original cell and put as a variable in the code
Related
This question already has an answer here:
Format specific text within a cell with VBA?
(1 answer)
Closed 4 years ago.
I need to be able to insert a colored symbol while entering text in a cell. I can do it in Word with a macro but in Excel I can only replace the entire cell.
Alternatively is there a way to apply a font style to selected characters (not the whole cell) using vba?
From a simple use of the macro recorder, you should be able to use .characters().font to add font/color/etc. to a portion of a string:
ActiveCell.FormulaR1C1 = "Text here"
Range("A1").Select
With ActiveCell.Characters(Start:=9, Length:=1).Font
.Name = "Verdana"
.FontStyle = "Regular"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Is there a way to assign a font to a range?
Let's say I have an object myFont. I can write:
with Range("A1").Font
.Bold=myFont.Bold
.Size=myFont.Size
same with other properties
end with
but there are a lot of font properties. Is there a way to do something like
Range("A1").Font=myFont?
No one-liner to do what you want. One possible shortcut below, but you're really still iterating over each property...
Dim p, myFont, rng As Range
'populate myFont, rng
For Each p In Array("Bold", "Color", "Size") 'for example
CallByName rng.Font, p, VbLet, CallByName(myFont, p, VbGet)
Next p
To change the font properties, follow the code below. Specifically, to change Range("A1") font name, use "Font.Name" as shown below.
To get this, I simply recorded a Macro of me changing the font and then stopping the Macro to view the code. Try recording Macros to find the property you need at times. Hope this helps.
Sub ChangeFontCustomRange()
' Change Font Name
'Select the Range to change font to
Range("A1").Select
'Change font properties, specifically, Font.Name
With Selection.Font
.Name = "Calibri" 'Type exact font name here
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
So I have a set of code that would select a specific range of text to be hidden and I need to have a macro that would select those hidden text and unhide them. However, I don't know how to select those hidden text without first displaying them. Is there a way to select hidden text while they're not displayed. I'm trying to create a dynamic template where if certain conditions are selected only certain text will appear. So far this is my code to unhide hidden text.
Sub Macro2()
'
' Macro2 Macro
'
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdParagraph, Count:=4, Extend:=wdExtend
With Selection.Font
.NameFarEast = "+Body Asian"
.NameAscii = "+Body"
.NameOther = "+Body"
.Name = "+Body"
.Size = 11
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
End Sub
The hidden text has to be visible on the screen to be selected. So you need this in your code. You don't need to un-hide them;
ActiveDocument.ActiveWindow.View.ShowHiddenText = True
If you want the user to not see the texts while running this may do the job. However, it is not tested;
Application.ScreenUpdating = False
Remember to turn it back on at the end of your code;
Application.ScreenUpdating = True
I have what might be a strange formula I need to create in Excel and not sure how to accomplish this.
I have a value in one worksheet that I want to pull into another cell in a separate worksheet. This part is easy. What I want to do though is have a leader text before that content is pulled in (in the same cell). So far I think this is easy too. Now the complicated part. I want the leader text to be one color and weight and the text pulled in from worksheet 1 to be a different color and weight.
Any thoughts? So it might look like this:
From: Brian's Business
Where "From:" is Red and Bold and "Brian's Business" is Black and normal weight.
Any ideas on how I can accomplish this task?
Thanks in advance.
Brian
This is what I did with the VBA macro, you can do the same thing and adopt it to your needs
Sub Macro1()
Range("F28").Select
ActiveCell.FormulaR1C1 = "hjkljhklhjkl : ddfff"
With ActiveCell.Characters(Start:=1, Length:=0).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16777216
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=8, Length:=2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16777216
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=10, Length:=11).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
I have two cells A1 and A2. I want to merge them and store in A3 keeping the formatting intact. I was able to use the below code to do this. But there is a huge performance issue. Can any one suggest a better solution? Is there a simpler way to do this?
Sub Merge_Cells(rngFrom1 As Range, rngFrom2 As Range, rngTo As Range)
Dim iOS As Integer
Dim lenFrom1 As Integer
Dim lenFrom2 As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
lenFrom1 = rngFrom1.Characters.Count
lenFrom2 = rngFrom2.Characters.Count
rngTo.Value = rngFrom1.Text & rngFrom2.Text
For iOS = 1 To lenFrom1
With rngTo.Characters(iOS, 1).Font
.Bold = rngFrom1.Characters(iOS, 1).Font.Bold
.Size = 9 'rngFrom1.Characters(iOS, 1).Font.Size
.Color = rngFrom1.Characters(iOS, 1).Font.Color
.Italic = rngFrom1.Characters(iOS, 1).Font.Italic
.Strikethrough = rngFrom1.Characters(iOS, 1).Font.Strikethrough
.Underline = rngFrom1.Characters(iOS, 1).Font.Underline
End With
Next iOS
For iOS = 1 To lenFrom2
With rngTo.Characters(lenFrom1 + iOS, 1).Font
.Name = rngFrom2.Characters(iOS, 1).Font.Name
.Bold = rngFrom2.Characters(iOS, 1).Font.Bold
.Size = 9 'rngFrom2.Characters(iOS, 1).Font.Size
.Color = rngFrom2.Characters(iOS, 1).Font.Color
.Italic = rngFrom2.Characters(iOS, 1).Font.Italic
.Strikethrough = rngFrom2.Characters(iOS, 1).Font.Strikethrough
.Underline = rngFrom2.Characters(iOS, 1).Font.Underline
End With
Next iOS
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Three suggestions:
1. Set a character's properties only if you need to
It's possible (I don't know for sure) that setting a character's properties is more expensive than getting a character's properties. If the cost differential is high enough then it makes sense to check the property to see if it needs to be set, before you actually set it.
So, for example, your code would become:
Sub Merge_Cells2(rngFrom1 As Range, rngFrom2 As Range, rngTo As Range)
Dim iOS As Integer
Dim lenFrom1 As Integer
Dim lenFrom2 As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
lenFrom1 = rngFrom1.Characters.Count
lenFrom2 = rngFrom2.Characters.Count
rngTo.Value = rngFrom1.Text & rngFrom2.Text
For iOS = 1 To lenFrom1
With rngTo.Characters(iOS, 1).Font
If .Bold <> rngFrom1.Characters(iOS, 1).Font.Bold Then .Bold = rngFrom1.Characters(iOS, 1).Font.Bold
If .Size <> 9 Then .Size = 9
If .Color <> rngFrom1.Characters(iOS, 1).Font.Color Then .Color = rngFrom1.Characters(iOS, 1).Font.Color
If .Italic <> rngFrom1.Characters(iOS, 1).Font.Italic Then .Italic = rngFrom1.Characters(iOS, 1).Font.Italic
If .StrikeThrough <> rngFrom1.Characters(iOS, 1).Font.StrikeThrough Then .StrikeThrough = rngFrom1.Characters(iOS, 1).Font.StrikeThrough
If .Underline <> rngFrom1.Characters(iOS, 1).Font.Underline Then .Underline = rngFrom1.Characters(iOS, 1).Font.Underline
End With
Next iOS
For iOS = 1 To lenFrom2
With rngTo.Characters(lenFrom1 + iOS, 1).Font
If .Bold <> rngFrom2.Characters(iOS, 1).Font.Bold Then .Bold = rngFrom2.Characters(iOS, 1).Font.Bold
If .Size <> 9 Then .Size = 9
If .Color <> rngFrom2.Characters(iOS, 1).Font.Color Then .Color = rngFrom2.Characters(iOS, 1).Font.Color
If .Italic <> rngFrom2.Characters(iOS, 1).Font.Italic Then .Italic = rngFrom2.Characters(iOS, 1).Font.Italic
If .StrikeThrough <> rngFrom2.Characters(iOS, 1).Font.StrikeThrough Then .StrikeThrough = rngFrom2.Characters(iOS, 1).Font.StrikeThrough
If .Underline <> rngFrom2.Characters(iOS, 1).Font.Underline Then .Underline = rngFrom2.Characters(iOS, 1).Font.Underline
End With
Next iOS
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
As I mentioned, I don't really know if this is a win, and the degree of advantage might vary from property to property. Maybe someone more knowledgable than I can comment. Or you can just try it out and see if it helps.
2. Set size all at once
Since you seem to be setting size to 9 all the time, I'd suggest setting size to 9 for the entire cell all at once, a rather than character by character. Then again, maybe you commented it out because you intend to restore size copying, and if so, this suggestion won't work.
3. Exploit sparseness
If the formatting is sparse, then you can check long runs of characters (or entire cells) for a particular property before you do anything. For example, if many cells have no bolding, check each cell before doing anything else. You might not have to do anything at all about bolding. My Excel returns Null when a property isn't uniform across a run of characters. (ymmv) If you get a Null, then you know you'll have to slice that character run more finely.
4. Addendum
#DavidZemens' suggestion about font size led me to this idea, which pays off only if Set is more expensive than Get for character properties. One could by inspection formulate a guess of the most common character style (font, size, color, bold, etc.), define that by hand as a cell style and apply it to the target range by hand. That would minimize the number of If's that trigger property sets.
-hth