Shading a Calendar (If/Then?)

clint_redhot

New Member
Joined
Nov 14, 2011
Messages
6
I am making a calendar for work. We are a flooring company that contracts through a large nationwide home store. The calendar I am making will go in these stores so that the personnel will be able to set up measure dates with the customers while they are in the store (rather than us calling 24-48hrs later to set it up ourselves). Now that you have an idea of WHY I am making this, perhaps you will understand why I need this question answered...

I have the calendar made. I found a good macros online and invoked it...worked great. I manipulated it a bit for appearance but it's basically the same. In this calendar, we want the dates to be shaded red if they are not scheduled and shaded green if they are. What would be my best route for doing this? What makes it more confusing is that I need to be able to enable this on a laptop we leave at the store but we only want the store employees to be able to schedule the measure, not be able to manipulate anything else.

To be honest, my job is riding on this. I'm completely lost. If anyone has any experience in this or if anyone thinks that they can help me, I could really, really use it...this has to be basically done on Thursday. I have many more questions that need answering but this is the start. Side note, each date also has multiple time slots that I need to put in...I haven't done that, yet. Help:confused:
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
Clint welcome to the Forum,

What type of calendar, do you mean you are using a UserForm or cells, what code are you currently using. What does the calendar look like?

Do want the cells to be locked.

It is always worth mentioning which version of Excel you are using.

Why would our job be on the line for this ?
 

clint_redhot

New Member
Joined
Nov 14, 2011
Messages
6
I am using 2007 for this. Here is the code...
' Unprotect sheet if had previous calendar to prevent error.
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
' Prevent screen flashing while drawing calendar.
Application.ScreenUpdating = False
' Set up error trapping.
On Error GoTo MyErrorTrap
' Clear area a1:g14 including any previous calendar.
Range("a1:g14").Clear
' Use InputBox to get desired month and year and set variable
' MyInput.
MyInput = InputBox("Type in Month and year for Calendar ")
' Allow user to end macro with Cancel in InputBox.
If MyInput = "" Then Exit Sub
' Get the date value of the beginning of inputted month.
StartDay = DateValue(MyInput)
' Check if valid date but not the first of the month
' -- if so, reset StartDay to first day of month.
If Day(StartDay) <> 1 Then
StartDay = DateValue(Month(StartDay) & "/1/" & _
Year(StartDay))
End If
' Prepare cell for Month and Year as fully spelled out.
Range("a1").NumberFormat = "mmmm yyyy"
' Center the Month and Year label across a1:g1 with appropriate
' size, height and bolding.
With Range("a1:g1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With
' Prepare a2:g2 for day of week labels with centering, size,
' height and bolding.
With Range("a2:g2")
.ColumnWidth = 11
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
' Put days of week in a2:g2.
Range("a2") = "Sunday"
Range("b2") = "Monday"
Range("c2") = "Tuesday"
Range("d2") = "Wednesday"
Range("e2") = "Thursday"
Range("f2") = "Friday"
Range("g2") = "Saturday"
' Prepare a3:g7 for dates with left/top alignment, size, height
' and bolding.
With Range("a3:g8")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
' Put inputted month and year fully spelling out into "a1".
Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
' Set variable and get which day of the week the month starts.
DayofWeek = WeekDay(StartDay)
' Set variables to identify the year and month as separate
' variables.
CurYear = Year(StartDay)
CurMonth = Month(StartDay)
' Set variable and calculate the first day of the next month.
FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
' Place a "1" in cell position of the first day of the chosen
' month based on DayofWeek.
Select Case DayofWeek
Case 1
Range("a3").Value = 1
Case 2
Range("b3").Value = 1
Case 3
Range("c3").Value = 1
Case 4
Range("d3").Value = 1
Case 5
Range("e3").Value = 1
Case 6
Range("f3").Value = 1
Case 7
Range("g3").Value = 1
End Select
' Loop through range a3:g8 incrementing each cell after the "1"
' cell.
For Each cell In Range("a3:g8")
RowCell = cell.Row
ColCell = cell.Column
' Do if "1" is in first column.
If cell.Column = 1 And cell.Row = 3 Then
' Do if current cell is not in 1st column.
ElseIf cell.Column <> 1 Then
If cell.Offset(0, -1).Value >= 1 Then
cell.Value = cell.Offset(0, -1).Value + 1
' Stop when the last day of the month has been
' entered.
If cell.Value > (FinalDay - StartDay) Then
cell.Value = ""
' Exit loop when calendar has correct number of
' days shown.
Exit For
End If
End If
' Do only if current cell is not in Row 3 and is in Column 1.
ElseIf cell.Row > 3 And cell.Column = 1 Then
cell.Value = cell.Offset(-1, 6).Value + 1
' Stop when the last day of the month has been entered.
If cell.Value > (FinalDay - StartDay) Then
cell.Value = ""
' Exit loop when calendar has correct number of days
' shown.
Exit For
End If
End If
Next

' Create Entry cells, format them centered, wrap text, and border
' around days.
For x = 0 To 5
Range("A4").Offset(x * 2, 0).EntireRow.Insert
With Range("A4:G4").Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.Font.Bold = False
' Unlock these cells to be able to enter text later after
' sheet is protected.
.Locked = False
End With
' Put border around the block of dates.
With Range("A3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With

With Range("A3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
.Resize(2, 8).EntireRow.Delete
' Turn off gridlines.
ActiveWindow.DisplayGridlines = False
' Protect sheet to prevent overwriting the dates.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True

' Resize window to show all of calendar (may have to be adjusted
' for video configuration).
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1

' Allow screen to redraw with calendar showing.
Application.ScreenUpdating = True
' Prevent going to error trap unless error found by exiting Sub
' here.
Exit Sub
' Error causes msgbox to indicate the problem, provides new input box,
' and resumes at the line that caused the error.
MyErrorTrap:
MsgBox "You may not have entered your Month and Year correctly." _
& Chr(13) & "Spell the Month correctly" _
& " (or use 3 letter abbreviation)" _
& Chr(13) & "and 4 digits for the Year"
MyInput = InputBox("Type in Month and year for Calendar")
If MyInput = "" Then Exit Sub
Resume
End Sub

When we sat down and went over the very basics of what was wanted, I was under a completely different understanding of it all...and it was something I could do and understand. In this case, they've changed around everything 100% and now I'm clueless and running out of time. Locked...I'm not quite sure?

Thank you!
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
You haven't copied all of the code as non of the variables are shown.

If you got this from a website what is the link that might be easier to look at.

An screen shot would be useful.
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
Ok I have worked out the Variables to get this working.

All it is doing is creating a table. Is the data going into the rows below the date number if so then you need to look to create something behind the worksheet to apply the colours that should be easy enough once you tell me.

You can look at conditional formatting to do this and add that to the code as it builds the table.
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
Here is the recorded conditional formatting that will help you out.

Sub mcrCondFormat1()
'
' Conditional formatting added to the sheet
'
'
Range("A2:G12").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=A2>0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=A2="""""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A2").Select
End Sub
 

clint_redhot

New Member
Joined
Nov 14, 2011
Messages
6
That really is all of it...here is the website for it : http://support.microsoft.com/kb/150774


Yes...we have different time slots for different days. We are closed Sundays. So...

M,W,F we have slots from :
8-9:30, 9:30-11, 11-12:30, 12:30-2, 2-3:30

T,TH
9:30-11, 11-12:30, 12:30-2, 2-3:30, 3:30-5, 5-6:30

Sat
9:30-11, 11-12:30, 12:30-2

Within those slots, they all need to be red if they aren't scheduled with an appt (this calendar is what the store will see and use but only be able to click on it and have something pop up that they can input customer info and email). If that time slot is taken, it needs to turn green. I know this is so much, I'm sorry...if perhaps you could just assist me with one time slot, I'd then be able to go off and try to swim on my own ;) It's been so long since I've taken Excel and my expertise is in Networking thus far...although, I'm still a long way away from gaining my MCSE or degree. I do have my A+ but so much has slipped my mind...I feel completely dumb right now.
 

clint_redhot

New Member
Joined
Nov 14, 2011
Messages
6
Alright, my coworker and I have come up with a very simple description and I believe I have the basis of how to go about it but I wanted to run it by you, also.

P will be available (aka y) and Q will be not available (aka n=not available). The dates and the month need to be white.

P will take you to another screen where you can input the customers info and Q will obviously mean no action is performed (no pop up). Is this something that you would have time to assist me with in regards to just doing on time slot? I can take it from there. If not, I really appreciate what help you've given me thus far...it's been very appreciated. Thank you so much!!!
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
I have to ask Clint if you have Microsoft Office why aren't you looking to use Outlook for this, the calendar part is exactly what you want to use and will facilitate this, and you can use the Contact section to record all of your customer details and the calendar section to place in the appointments and colour code them, you can set the working week and timings.

Also depending on your organisation there is the contact management system which can be used.
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
This code will create a new sheet and ask you to add the month year and it then creates a table with time slots and conditional formatting

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> CreateMonthSheet()<br><SPAN style="color:#00007F">Dim</SPAN> inp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>Sheets.Add<br>inp = InputBox("Please enter the Month and year", "Test")<br>ActiveSheet.Name = Format(inp, "MMMM YYYY")<br>Range("B3") = inp<br>Range("B4") = "01" & inp<br>Range("c4") = Range("b4")<br>Columns("c").NumberFormat = "DDDD"<br>Range("B4:C4").Select<br>Range("B5").FormulaR1C1 = "=R[-1]C+1"<br>Range("B5").Select<br>Selection.AutoFill Destination:=Range("B5:B34"), Type:=xlFillDefault<br>Range("B5:B34").Select<br>Range("C4").Select<br>Selection.AutoFill Destination:=Range("C4:C34")<br>Range("C4:C34").Select<br>Range("D3") = "08:00 - 09:00"<br>Range("E3") = "09:00 - 10:00"<br>Range("F3") = "10:00 - 11:00"<br>Range("G3") = "11:00 - 12:00"<br>Range("H3") = "12:00 - 13:00"<br>Range("I3") = "13:00 - 14:00"<br>Range("J3") = "14:00 - 15:00"<br>Range("K3") = "15:00 - 16:00"<br>Range("L3") = "16:00 - 17:00"<br>Columns("B:L").EntireColumn.AutoFit<br><SPAN style="color:#007F00">'Add conditional Formating</SPAN><br>    Range("D4:L34").Select<br>    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=D4="""""<br>    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority<br>    <SPAN style="color:#00007F">With</SPAN> Selection.FormatConditions(1).Interior<br>        .PatternColorIndex = xlAutomatic<br>        .Color = 5287936<br>        .TintAndShade = 0<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Selection.FormatConditions(1).StopIfTrue = <SPAN style="color:#00007F">False</SPAN><br>    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=D4>0"<br>    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority<br>    <SPAN style="color:#00007F">With</SPAN> Selection.FormatConditions(1).Interior<br>        .PatternColorIndex = xlAutomatic<br>        .Color = 255<br>        .TintAndShade = 0<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Selection.FormatConditions(1).StopIfTrue = <SPAN style="color:#00007F">False</SPAN><br>    Range("A1").Select<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 

Forum statistics

Threads
1,082,344
Messages
5,364,803
Members
400,814
Latest member
gangstar67

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top