ExcelBanter - Changing Multiple Cell Colours based on Drop Down option Selected

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Changing Multiple Cell Colours based on Drop Down option Selected (https://www.excelbanter.com/excel-programming/372857-changing-multiple-cell-colours-based-drop-down-option-selected.html)

Changing Multiple Cell Colours based on Drop Down option Selected

Hiya,

I'm trying to fix up a Work Roster created in Excel that has VB codes but I
have very very limited knowledge of VB so I am hoping someone will be able to
help me with my problem.

What's suppose to happen is when you click on a drop down menu and select an
option, like Annnual Leave. Training or Sick Leave, it's suppose to shade in
the three cells under Start, Lunch and Finish in a particular colour and also
automatically populate the time to 7 hrs 30 mins (7:30). If you select RDO
though, the hours should stay at 0.00.

However, whenever I click on the drop down and select an option, it
generates a Run-Time error 13 - Type Mismatch. When I click on debug, it
highlights the following code in yellow:

DropDownCell = Sheets("Roster").DropDowns("Drop Down " + index).LinkedCell

I have no idea on how to fix the error because I didn't create the file and
also, I think the file was created in Excel 95 or something. It works
perfectly if you run it in Excel 95 but when I run it in Excel 2003 it
doesn't work.

Can anyone please help?

I've included the rest of the VB codes below:

Sub FormatTimes(index)
Dim ColourRange As Object
Dim NumberOfHours As Object

DropDownCell = Sheets("Roster").DropDowns("Drop Down " + index).LinkedCell
ColourType = Range(DropDownCell).Value
If ColourType = 1 Then
DesiredColour = xlNone
Else
DesiredColour = Range("FirstColour").Offset(ColourType - 2,
0).Interior.ColorIndex
End If

Set ColourRange = Range(DropDownCell).Offset(0, -4).Range("A1:C1")
Set NumberOfHours = Range(DropDownCell).Offset(0, -1)
Sheets("Roster").Unprotect

Select Case ColourType
Case 2
NumberOfHours.Value = "0:00"
Case 3, 5, 6
NumberOfHours.Value = "7:30"
Case Else
NumberOfHours.FormulaR1C1 = "=RC[-1]-RC[-2]-RC[-3]"
End Select

With ColourRange.Interior
.ColorIndex = DesiredColour
.Pattern = xlSolid
End With
Sheets("ROSTER").Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True

End Sub

Changing Multiple Cell Colours based on Drop Down option Selected

Changing Multiple Cell Colours based on Drop Down option Selec

Thank you SOOOOO much for that Bob. That bit works PERFECTLY now!

I've been pulling my hair out trying to work it out and it was so simple.

But now its created another problem. There's a Clear button that when
clicked is supposed to clear all the cells and drop down options so it is
ready for next month's data to be entered, but when I click it, the following
error message appears:

Run-Time Error '1004' - Delete method of Worksheet class failed.

When I click on debug the following code is highlighted:

Sheets("ROSTER").Delete

The full code is as below:

Sub RestoreBackup()
Response = MsgBox("Are you certain you want to delete this month's
roster?", vbYesNo, "Warning!")

If Response = vbYes Then
Response = MsgBox("Did you answer the previous question correctly?",
vbYesNo, "Warning!")
Else
Exit Sub
End If

If Response = vbYes Then
Response = MsgBox("Are you sure?", vbYesNo, "Warning!")
Else
Exit Sub
End If

If Response = vbYes Then
Application.DisplayAlerts = False
Sheets("ROSTER").Delete
Application.DisplayAlerts = True
Sheets("Backup").Visible = True
Sheets("Backup").Copy Befo=Sheets("Date")
Sheets("Backup (2)").Name = "ROSTER"
Sheets("Backup").Visible = False
End If
End Sub

Can you assist with this? Or can anyone assist?

"Bob Phillips" wrote:

Seems that VBA is now stricter with how it concatenates.

Change it to

DropDownCell = Sheets("Roster").DropDowns("Drop Down " &
index).LinkedCell

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Grumpy Head" <Grumpy wrote in message
...
Hiya,

I'm trying to fix up a Work Roster created in Excel that has VB codes but
I
have very very limited knowledge of VB so I am hoping someone will be able
to
help me with my problem.

What's suppose to happen is when you click on a drop down menu and select
an
option, like Annnual Leave. Training or Sick Leave, it's suppose to shade
in
the three cells under Start, Lunch and Finish in a particular colour and
also
automatically populate the time to 7 hrs 30 mins (7:30). If you select
RDO
though, the hours should stay at 0.00.

However, whenever I click on the drop down and select an option, it
generates a Run-Time error 13 - Type Mismatch. When I click on debug, it
highlights the following code in yellow:

DropDownCell = Sheets("Roster").DropDowns("Drop Down " +
index).LinkedCell

I have no idea on how to fix the error because I didn't create the file
and
also, I think the file was created in Excel 95 or something. It works
perfectly if you run it in Excel 95 but when I run it in Excel 2003 it
doesn't work.

Can anyone please help?

I've included the rest of the VB codes below:

Sub FormatTimes(index)
Dim ColourRange As Object
Dim NumberOfHours As Object

DropDownCell = Sheets("Roster").DropDowns("Drop Down " +
index).LinkedCell
ColourType = Range(DropDownCell).Value
If ColourType = 1 Then
DesiredColour = xlNone
Else
DesiredColour = Range("FirstColour").Offset(ColourType - 2,
0).Interior.ColorIndex
End If

Set ColourRange = Range(DropDownCell).Offset(0, -4).Range("A1:C1")
Set NumberOfHours = Range(DropDownCell).Offset(0, -1)
Sheets("Roster").Unprotect

Select Case ColourType
Case 2
NumberOfHours.Value = "0:00"
Case 3, 5, 6
NumberOfHours.Value = "7:30"
Case Else
NumberOfHours.FormulaR1C1 = "=RC[-1]-RC[-2]-RC[-3]"
End Select

With ColourRange.Interior
.ColorIndex = DesiredColour
.Pattern = xlSolid
End With
Sheets("ROSTER").Protect DrawingObjects:=True, Contents:=True,
Scenarios _
:=True

End Sub