Changing a cell range automatically

[Tallie]

I'm setting up a work schedule for a year in excel 2003 to begin with then upgrading next year to 2013.

I want to be able to have all the cells set up so if a certain word is entered then a certain number of cells after it will change according to the word entered.

There will be approx 500 people on the schedule and 52 weeks of the year so thousands of cells involved and also at least 40 different words or terms to be used!

Each word or term will have a set amount of weeks associated with it so if I enter "cat" alongside Bob's name in the week of 13/10/14 it will colour that week and the following 6 weeks in blue thus meaning the job will last 7 weeks.


Also, and this isn't essential at this point, i'd like a front page where there is a grey search box where you can pick criteria such as job name "cat" and the week number or date and it will list how many people are associated with that job on that week.


Any help would be much appreciated!

 

[Fluff]

Hi
is this the sort of thing you're looking for?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Wks As Integer

Application.EnableEvents = False

    With Sheet2
On Error Resume Next
    Wks = .Range("A1").CurrentRegion.Find(what:=Target.Value, After:=.Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, 1)
On Error GoTo 0
    End With

    If Not Wks = "0" Then
        Range(Target, Target.Offset(0, Wks)).Interior.ColorIndex = 33
    Else
        MsgBox "Word in cell " & Target.Address & " not found"
    End If

Application.EnableEvents = True

End Sub

As you haven't said anything about you workbook, I've set up 2 sheets
Sheet1 has names in column A starting in A2 & week begining dates in row 1.
sheet2 has a list of job in column A starting in A1 & the number of weeks in column B

 

[Tallie]

Hi,

Thank you for your help and for replying.

Trying it now.

Not sure what I'm doing wrong but it doesn't seem to be doing anything

 

[Rick Rothstein]

There will be approx 500 people on the schedule and 52 weeks of the year so thousands of cells involved and also at least 40 different words or terms to be used!

Question... If your sheet only shows 52 weeks of the year, what should happen if the user types, say, "school" in December 20th?

 

[Tallie]

It will be a rolling year

 

[Rick Rothstein]

It will be a rolling year

Okay, try this... on a separate sheet (I assumed Sheet2, change the red text if that guess was wrong), starting on Row 1, put what I called your job names (cat, school, etc.) in Column A, the number of cells to color in Column B and the ColorIndex you want to color those cells with in Column C. Once you have setup Sheet2 (or whatever sheet you actually use), then go to the sheet with your data grid, right-click the name tab for the sheet and select "View Code" from the popup menu that appears, then copy/paste the following code into the code window that just opened up...

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim R As Long
  Static Jobs As Variant
  If IsEmpty(Jobs) Then
    Jobs = Sheets("Sheet2").Range("A1:C" & Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row).Value
  End If
  For R = 1 To UBound(Jobs)
    If Jobs(R, 1) = Target.Value Then
      With Target.Resize(, Jobs(R, 2))
        .Interior.ColorIndex = Jobs(R, 3)
        .Font.Color = TextColorToUse(.Interior.Color)
      End With
      Exit For
    End If
  Next
End Sub


'  This function returns the color to use for
'  text to make it readable on a dark background
Function TextColorToUse(BackColor As Long) As Long
  Dim Luminance As Long
  Luminance = 77 * (BackColor Mod &H100) + _
              151 * ((BackColor \ &H100) Mod &H100) + _
              28 * ((BackColor \ &H10000) Mod &H100)
  '  Default value of TextColorToUse is 0-Black, set
  '  it to White if the Luminance is less than 32640
  If Luminance < 32640 Then TextColorToUse = vbWhite
End Function

That should be it... type one of the words in the Jobs list in any cell and the associated number of cells will be colored with the indicated ColorIndex value.

 

[Rick Rothstein]

Okay, try this... on a separate sheet (I assumed Sheet2, change the red text if that guess was wrong), starting on Row 1, put what I called your job names (cat, school, etc.) in Column A, the number of cells to color in Column B and the ColorIndex you want to color those cells with in Column C. Once you have setup Sheet2 (or whatever sheet you actually use), then go to the sheet with your data grid, right-click the name tab for the sheet and select "View Code" from the popup menu that appears, then copy/paste the following code into the code window that just opened up...

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim R As Long
  Static Jobs As Variant
  [B][COLOR=#FF0000]If Target.Count > 1 Then Exit Sub[/COLOR][/B]
  If IsEmpty(Jobs) Then
    Jobs = Sheets("Sheet2").Range("A1:C" & Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row).Value
  End If
  For R = 1 To UBound(Jobs)
    If Jobs(R, 1) = Target.Value Then
      With Target.Resize(, Jobs(R, 2))
        .Interior.ColorIndex = Jobs(R, 3)
        .Font.Color = TextColorToUse(.Interior.Color)
      End With
      Exit For
    End If
  Next
End Sub
 
'  This function returns the color to use for
'  text to make it readable on a dark background
Function TextColorToUse(BackColor As Long) As Long
  Dim Luminance As Long
  Luminance = 77 * (BackColor Mod &H100) + _
              151 * ((BackColor \ &H100) Mod &H100) + _
              28 * ((BackColor \ &H10000) Mod &H100)
  '  Default value of TextColorToUse is 0-Black, set
  '  it to White if the Luminance is less than 32640
  If Luminance < 32640 Then TextColorToUse = vbWhite
End Function

That should be it... type one of the words in the Jobs list in any cell and the associated number of cells will be colored with the indicated ColorIndex value.

I think you should probably add the code line I show in red to protect against a large range of cells being deleted.

 

[Tallie]

Thank you very much.

I have set up sheet 2 as you suggested and pasted the above into the code on sheet 1.

When I type one of the names I have put in sheet 2 it comes up with a runtime error 1004 - unable to set the colorIndex property of the interior class

When I click debug it highlights the following line : .Interior.ColorIndex = Jobs(R, 3)

Any idea what I have done wrong?

 

[Rick Rothstein]

I have set up sheet 2 as you suggested and pasted the above into the code on sheet 1.

When I type one of the names I have put in sheet 2 it comes up with a runtime error 1004 - unable to set the colorIndex property of the interior class

When I click debug it highlights the following line : .Interior.ColorIndex = Jobs(R, 3)

Any idea what I have done wrong?

I am not sure what to tell you... I tested the code before I posted it and then again just now to double check... it works fine for me. If you want to send me a copy of the workbook that does not work, I will be happy to look at it and see if I can figure out what the problem is. My email address is...

rick DOT news AT verizon DOT net

 

[Rick Rothstein]

Okay, I received your file and found two things "wrong". First, you used things like #FF00FF for the color... I was expecting a number between 1 and 56 (the ColorIndex). I have modified the code to handle your method of inputting the color. Second, you did not mention that each date occupies two columns rather than the one column most people would assume. I have change the code to now fill in the correct number of dates. It is not clear from your example sheet whether you want the location to be placed in the first column for each of the dates that my code colors in... I can do that automatically for you if you want... just let me know and I will adjust the code for you; however, you will have to tell me how to know whether to put AM or PM in the second column for each date or, alternately, I could have the code ask the user and then fill that in automatically as well. Just let me know. Anyway, here is the adjusted code...

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim R As Long
  Static Jobs As Variant
  If Target.Count > 1 Then Exit Sub
  If IsEmpty(Jobs) Then
    Jobs = Sheets("Sheet2").Range("A1:C" & Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row).Value
  End If
  For R = 1 To UBound(Jobs)
    If Jobs(R, 1) = Target.Value Then
      With Target.Resize(, 2 * Jobs(R, 2))
        .Interior.Color = CLng(Replace(Jobs(R, 3), "#", "&H"))
        .Font.Color = TextColorToUse(.Interior.Color)
      End With
      Exit For
    End If
  Next
End Sub
 
'  This function returns the color to use for
'  text to make it readable on a dark background
Function TextColorToUse(BackColor As Long) As Long
  Dim Luminance As Long
  Luminance = 77 * (BackColor Mod &H100) + _
              151 * ((BackColor \ &H100) Mod &H100) + _
              28 * ((BackColor \ &H10000) Mod &H100)
  '  Default value of TextColorToUse is 0-Black, set
  '  it to White if the Luminance is less than 32640
  If Luminance < 32640 Then TextColorToUse = vbWhite
End Function