aledebortoli
New Member
- Joined
- Feb 19, 2023
- Messages
- 6
- Office Version
- 365
- Platform
- 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
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