Need help adding If/Then/Else Statement

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
 
R

reklamo

I'm not sure if I understood your problwem correctly but you can try
following code:

Sub RCCode()
With ActiveSheet
R = ActiveSheet.Cells(.Rows.Count, 3).End(xlUp).Row
End With
For i = 2 To R
If IsEmpty(Cells(i, 2)) = True Then
Cells(i, 4).Value = Cells(i, 3).Value
Else
Cells(i, 4).Value = Cells(i, 2).Value & ": " & Cells(i, 3).Value
With Cells(i, 4).Characters(Start:=1, Length:=3).Font
.FontStyle = "Bold"
End With
End If
Next
End Sub

At the end it looks like following (with "AB:" etc in Bold):
B C D
RCCode PartyFix Party
AB Smith AB: Smith
Jones Jones
CC Zimmer CC: Zimmer
Karr Karr
DD Test DD: Test

regards
reklamo
 
I

imelda1ab

I'm not sure if I understood your problwem correctly but you can try
following code:

Sub RCCode()
    With ActiveSheet
        R = ActiveSheet.Cells(.Rows.Count, 3).End(xlUp).Row
    End With
    For i = 2 To R
        If IsEmpty(Cells(i, 2)) = True Then
            Cells(i, 4).Value = Cells(i, 3).Value
        Else
            Cells(i, 4).Value = Cells(i, 2).Value & ": " & Cells(i, 3).Value
            With Cells(i, 4).Characters(Start:=1, Length:=3).Font
                .FontStyle = "Bold"
            End With
        End If
    Next
End Sub

At the end it looks like following (with "AB:" etc in Bold):
    B               C             D
RCCode  PartyFix        Party
AB      Smith   AB: Smith
        Jones   Jones
CC      Zimmer  CC: Zimmer
        Karr    Karr
DD      Test    DD: Test

regards
reklamo



imelda1ab said:
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- Hide quoted text -

- Show quoted text -
Perfect! I just had to add .FontStyle = "Bold" to the first If
statement. THANK YOU THANK YOU THANK YOU!
 
I

imelda1ab

I'm not sure if I understood your problwem correctly but you can try
following code:
Sub RCCode()
    With ActiveSheet
        R = ActiveSheet.Cells(.Rows.Count, 3).End(xlUp).Row
    End With
    For i = 2 To R
        If IsEmpty(Cells(i, 2)) = True Then
            Cells(i, 4).Value = Cells(i, 3).Value
        Else
            Cells(i, 4).Value = Cells(i, 2).Value & ": " &Cells(i, 3).Value
            With Cells(i, 4).Characters(Start:=1, Length:=3).Font
                .FontStyle = "Bold"
            End With
        End If
    Next
End Sub
At the end it looks like following (with "AB:" etc in Bold):
    B               C             D
RCCode  PartyFix        Party
AB      Smith   AB: Smith
        Jones   Jones
CC      Zimmer  CC: Zimmer
        Karr    Karr
DD      Test    DD: Test
regards
reklamo

imelda1ab said:
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- Hide quoted text -
- Show quoted text -

Perfect!  I just had to add .FontStyle = "Bold" to the first If
statement.  THANK YOU THANK YOU THANK YOU!- Hide quoted text -

- Show quoted text -

One more question. When I have to update my data, and then I rerun
the macro, all of the characters in Column D become bold. How do I
apply .FontStyle="Regular" for the entire column before running the
rest of the Macro?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top