I
imelda1ab
If I knew how to write macros, I would tell the macro I have below to
run
IF Len(B1) >1 ...
ELSE [if Len(B1)<1 IsNull or whatever is correct] paste C1 pasted into
D; apply bold to the first three characters and do not change the font
size.
B C D
RCCode PartyFix Party
AB Smith AB: Smith
Jones Jones
Sub RCCodeFixFont()
Dim CalcMode As Long
Dim sLF As String
Dim R As Long
Dim cell As Range
Dim p As Long
sLF = Chr$(58) & Chr$(160)
With Application
.ScreenUpdating = False
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
R = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range("D1").Resize(R, 1)
'comment out the next 4 lines if you've already
'got the text into the cells
.Formula = "=B1&CHAR(58)&CHAR(160)&C1"
.Calculate
.Copy
.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'apply common formats to entire column at once
With .Font
.Name = "Times New Roman"
.Size = 11
.FontStyle = "Regular"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.WrapText = True
For Each cell In .Cells
With cell
p = InStr(.Value, sLF)
If p > 1 Then
With .Characters(Start:=1, Length:=p - 1).Font
.FontStyle = "Bold"
.Size = 8
End With
End If
End With 'cell
Next cell
End With 'entire range
End With 'active sheet
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
run
IF Len(B1) >1 ...
ELSE [if Len(B1)<1 IsNull or whatever is correct] paste C1 pasted into
D; apply bold to the first three characters and do not change the font
size.
B C D
RCCode PartyFix Party
AB Smith AB: Smith
Jones Jones
Sub RCCodeFixFont()
Dim CalcMode As Long
Dim sLF As String
Dim R As Long
Dim cell As Range
Dim p As Long
sLF = Chr$(58) & Chr$(160)
With Application
.ScreenUpdating = False
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
R = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range("D1").Resize(R, 1)
'comment out the next 4 lines if you've already
'got the text into the cells
.Formula = "=B1&CHAR(58)&CHAR(160)&C1"
.Calculate
.Copy
.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'apply common formats to entire column at once
With .Font
.Name = "Times New Roman"
.Size = 11
.FontStyle = "Regular"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.WrapText = True
For Each cell In .Cells
With cell
p = InStr(.Value, sLF)
If p > 1 Then
With .Characters(Start:=1, Length:=p - 1).Font
.FontStyle = "Bold"
.Size = 8
End With
End If
End With 'cell
Next cell
End With 'entire range
End With 'active sheet
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub