Bold and color text

aledebortoli

New Member
Joined
Feb 19, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Good Afternoon

I have this code and in the following

If oCell <> Codei Or iCell <> ID Or gCell <> Px Or fCell <> Pr Then
dCell.Value = Codei & " " & "x" & Px & "+" & Pxc & " " & Pr & " " & Nts

I would have the Nts bolded and text in red but I cannot find a solution.

Can you please help me ?

Here is the full code

Thanks



Sub Bookings()

Dim Rm As Range, Dt As Range, Myrng As Range, Staff As Range
Dim endCol As Range, StCol As Range, StRow As Range, endRow As Range
Dim Codei As Range, Col As Range, Px As Range, Pxc As Range, ID As Range, orange As Range, Nts As Range
Dim rng As Range
Dim Pr As Integer
Pr = 32767
Dim i As String
Dim Dws As Worksheet, Cws As Worksheet
Dim X As Integer
Dim LastRow As Long
Dim aCell As Range, bCell As Range, dCell As Range
Dim oCell As Variant
Dim iCell As Variant
Dim gCell As Variant
Dim fCell As Variant
Dim eCell As Variant
Dim hCell As Variant

On Error Resume Next
'variables
Set Cws = Sheet1
Set Dws = Sheet2
Set StCol = Cws.Range("I5")
Set endCol = Cws.Range("K5")
Set StRow = Cws.Range("M5")
Set endRow = Cws.Range("O5")


'filter the data to limit
FilterRng
'set the range to loop through
LastRow = Dws.Range("AI" & Rows.Count).End(xlUp).Row
Set Myrng = Dws.Range("AI7:AI" & LastRow)

'set the range to loop through
'LastRow = Dws.Range("C" & Rows.Count).End(xlUp).Row
'Set Myrng = Dws.Range("C7:C" & LastRow) 'data sheet columns
'clear the values from the calendar
Cws.Range("G12:AK94").ClearContents
Cws.Range("G12:AK94").Interior.ColorIndex = xlNone
'LOOP 1"""""""""""""""""""""""""""""""
'set the variable for the number of rows and loop through
For X = StRow To endRow
Set Staff = Cws.Cells(X, 6)
'LOOP 2"""""""""""""""""""""""""""""'
'loop through column range
For Each dCell In Cws.Range(Cells(X, StCol), Cells(X, endCol))
If Not dCell Is Nothing Then
'set the date variable
Set Dt = Cells(10, dCell.Column)
'FIND FUNCTION""""""""""""""""""""
'find the rooms
Set aCell = Myrng.Find(What:=Staff, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'set the room variable
Set bCell = aCell
'LOOP 3"""""""""""""""""""""""
'loop through the filtered data
Do
'find the next room with a booking
Set aCell = Myrng.FindNext(After:=aCell)
'establish the dates to add
'codice per lunghezza colore booking 0,1 valore start data 0,2 valore end data
If aCell.Offset(0, 1).Value <= Dt.Value And aCell.Offset(0, 2).Value >= Dt.Value Then
'set the variables
Set Codei = aCell.Cells(1, 5)
'Set Codei = aCell.Cells(1, 5)
Set Col = aCell.Cells(1, 4) 'status
Set Px = aCell.Cells(1, 6) ' number of adult
Set Pxc = aCell.Cells(1, 7) ' number of children
Pr = aCell.Cells(1, 13) ' price
Set ID = aCell.Offset(0, -1) 'ID
Set Nts = aCell.Cells(1, 15) ' Notes
'add the names and reassign after once
If oCell <> Codei Or iCell <> ID Or gCell <> Px Or fCell <> Pr Then
dCell.Value = Codei & " " & "x" & Px & "+" & Pxc & " " & Pr & " " & Nts
Set oCell = Codei
Set iCell = ID
Set gCell = Px
fCell = Pr
Set eCell = Pxc
Set hCell = Nts


End If

'add the coloring
Select Case Col
Case Cws.Range("AR9").Value
dCell.Interior.ColorIndex = 43
Case Cws.Range("AR10").Value
dCell.Interior.ColorIndex = 3
Case Cws.Range("AR11").Value
dCell.Interior.ColorIndex = 38
Case Cws.Range("AR12").Value
dCell.Interior.ColorIndex = 37
Case Cws.Range("AR13").Value
dCell.Interior.ColorIndex = 48
'Case Cws.Range("AR18").Value
'dCell.Interior.ColorIndex = 37
'Case Cws.Range("AR19").Value
'dCell.Interior.ColorIndex = 37
'Case Cws.Range("AR22:AR27").Value
'dCell.Interior.ColorIndex = 27

End Select
End If
'exit when values are found
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
Else
Exit Do
End If
Loop 'LOOP 3 end
' """""""""""""""""""""""""""""""""""""""""""""'
End If
End If
Next dCell 'LOOP 2 end
' """"""""""""""""""""""""""""""""""""""""""""""
Next X 'LOOP 1 end
' """"""""""""""""""""""""""""""""""""""""""""""""'
On Error GoTo 0
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Try:

VBA Code:
Dim mystr As String, ntsstr As String 'this line could go to the top of procedure, where other declartions are listed

If oCell <> Codei Or iCell <> ID Or gCell <> Px Or fCell <> Pr Then
  ntsstr = Nts
  mystr = Codei & " x" & Px & "+" & Pxc & " " & Pr & " " 
  With dCell
    .Value = mystr & ntsstr
    With .Characters(Start:=Len(mystr) + 1, Length:=Len(ntsstr)).Font
      .FontStyle = "Bold"
      .Color = vbRed
    End With
  End With

BTW. Please note how CODE tags improve readability of the VBA code
 
Upvote 0
Hi Kaper,
Thanks a lot for your reply.
With your solution I have all the text in red. What I would have is just Nts in red and Codei & " x" & Px & "+"& Pxc & " "&> Pr & " " in black ( as normal )

How can I change the code ?

Thanks a lot in advance
 
Upvote 0

Forum statistics

Threads
1,226,464
Messages
6,191,182
Members
453,646
Latest member
BOUCHOUATA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top