This is a bigger one heres what you need .

1 command button named Command2
3 checkboxes named ChkBold , ChkItalic , and ChkUnderline .
1 commondialogbox named dlgColors
2 Rich Text Boxes named rtbChat , and RtbText .
1 ComboBox named cmbFonts

put this code in a form
Code:

Private Sub chkUnderline_Click()

   'toggle underline
   If ChkUnderline.Value = vbChecked Then
      RtbText.SelUnderline = True
   Else
      RtbText.SelUnderline = False
   End If
   
 RtbText.SetFocus
   
End Sub

Private Sub chkItalic_Click()

   'toggle italic
   If ChkItalic.Value = vbChecked Then
      RtbText.SelItalic = True
   Else
      RtbText.SelItalic = False
   End If
   
 RtbText.SetFocus
   
End Sub

Private Sub ChkBold_Click()
'toggle bold
   If ChkBold.Value = vbChecked Then
      RtbText.SelBold = True
   Else
      RtbText.SelBold = False
   End If
   
 RtbText.SetFocus
End Sub

Private Sub cmbFonts_Click()
On Error Resume Next

  'set the font
  RtbText.SelFontName = cmbFonts.List(cmbFonts.ListIndex)
  RtbText.SetFocus
End Sub

Private Sub Command1_Click()
On Error GoTo ErrorHandler

dlgColors.CancelError = True
dlgColors.ShowColor
RtbText.SelColor = dlgColors.Color
RtbText.SetFocus


ErrorHandler: 'user click 'Cancel'
End Sub

Private Sub Command2_Click()
 
  Dim strRTF As String, strFontName As String, lngFontColor As Long, lngFontSize As Long
  Dim blnBold As Boolean, blnUnderline As Boolean, blnItalic As Boolean
  
    'check if connected to someone
   ' If sckConnect.State = sckClosed Then
     '  MsgBox "You must be connected to someone."
     '  Exit Sub
   ' End If
   
  'get font-styles so we can reset them later
  blnBold = RtbText.SelBold
  blnUnderline = RtbText.SelUnderline
  blnItalic = RtbText.SelItalic
  lngFontColor& = RtbText.SelColor
  lngFontSize& = RtbText.SelFontSize
  strFontName$ = RtbText.SelFontName
  
  ''format text w/ nick and assign rtf to strRTF$
 ' RtbText.SelStart = 0
 ' RtbText.SelLength = 0
 ' RtbText.SelText = vbCrLf & txtNick.Text & ":" & vbTab
 ' RtbText.SelStart = 0
 ' RtbText.SelLength = Len(txtNick.Text) + 4 '4 = Length of vbCrLf + ':' + vbTab
 ' RtbText.SelColor = vbBlue
 ' RtbText.SelFontSize = 8
 ' RtbText.SelFontName = "Arial"
 ' RtbText.SelBold = True
 ' RtbText.SelUnderline = False
  'RtbText.SelItalic = False
  'RtbText.SelStart = 0
  'RtbText.SelLength = 0
  
  strRTF$ = RtbText.TextRTF + vbCrLf
  
  ''clear textbox
  RtbText.Text = ""
   
  ''reset font-styles
  RtbText.SelBold = blnBold
  RtbText.SelUnderline = blnUnderline
  RtbText.SelItalic = blnItalic
  RtbText.SelColor = lngFontColor&
  RtbText.SelFontSize = lngFontSize&
  RtbText.SelFontName = strFontName$
   
  ''show bottom half of textbox
  rtbChat.SelStart = Len(rtbChat.Text)
  rtbChat.SelLength = 0
  
  'print text in our rtbChat
  
  rtbChat.SelRTF = strRTF$

  Debug.Print strRTF$
  
  '**********************************
  '*********************************
  ' This is where the issue is . It's caused by VbCrLf
  ' if you remove the VbCrLf below and rerun the form     
  rtbChat.Text = rtbChat.Text + vbCrLf

  'scroll rtbChat down
  rtbChat.SelStart = Len(rtbChat.Text)
  rtbChat.SelLength = 0
  
  'set focus
  RtbText.SetFocus
  
  ''Send text to other person
  ''Call sckConnect.SendData(strRTF$)
End Sub

Private Sub Form_Load()
 
 Dim intBuffer As Integer, strFont As String
 
   'load printer fonts to combobox
   If Dir$(App.Path & "\fonts.dat") = "" Then
        'font file doesnt exist. Create it.
        Open App.Path & "\fonts.dat" For Output As #1
             For intBuffer% = 0 To Printer.FontCount - 1
                Call cmbFonts.AddItem(Printer.Fonts(intBuffer%))
                Print #1, Printer.Fonts(intBuffer%)
             Next intBuffer%
        Close #1
   Else
        'load fonts from file
        Open App.Path & "\fonts.dat" For Input As #1
             While Not EOF(1)
                Input #1, strFont$
                Call cmbFonts.AddItem(strFont$)
             Wend
        Close #1
   End If
   
 cmbFonts.ListIndex = 0
 ''cmbFonts.Sorted = True 'Alphabetize list


  'set combobox to "Arial"
  For intBuffer% = 0 To cmbFonts.ListCount - 1
    If cmbFonts.List(intBuffer%) = "Arial" Then cmbFonts.ListIndex = intBuffer%: Exit For
  Next intBuffer%
  

  'set rtbText's font-styles
  RtbText.SelBold = False
  RtbText.SelUnderline = False
  RtbText.SelItalic = False
  RtbText.SelColor = vbBlack
  RtbText.SelFontName = cmbFonts.List(cmbFonts.ListIndex)
  RtbText.SelFontSize = 10

End Sub
If you can see I'm trying to sperate the lines in the RTB
by a vbCrLf but when I do that it doesn't keep the new font settings .

Thanks for the help ,
Private