Cell data on one sheet as variable for use on another

[steve.waye]

Hi,

I'm relatively new to VBA so any help would be appreciated.

I have an Excel Workbook that I use to allocate staff to classes in our teaching section. My workbook has two sheets - 'Staff' and 'Program'.

The 'Staff' worksheet lists all staff, including their initials (e.g. SW).

The 'Program' worksheet has the teaching program with an adjacent space to enter the teacher's initials.

When I enter the staff member's initials on the 'Program' sheet, this cell and the adjacent two cells are highlighted a specific colour for that staff member.

I am currently using VBA to do this which works well. However, if I have a change of staff, I need to go into the VBA code to edit it to suit the new initials. This isn't a problem for me, but there are several other Head Teachers who want to use the Workbook for their own teaching sections and find the whole VBA thing a bit daunting. As such I want to password protect the code against access (and destruction).

I was hoping there was some way to declare the teacher initials on the 'Staff' sheet as variables which could then be used in the code in Module1.

Here's the code in Module1...

<CODE>Sub HighlightTextByTeacher(ByVal TeacherInitials As Range, ByVal CellToHighlight As Range)
Dim icolor As Integer
If ((Not Intersect(TeacherInitials, Range("E4:E57")) Is Nothing) Or (Not Intersect(TeacherInitials, Range("H4:H57")) Is Nothing) Or (Not Intersect(TeacherInitials, Range("K4:K57")) Is Nothing)) Then
Select Case UCase(TeacherInitials.Value)
Case ""
icolor = -1
Case "SW"
icolor = 22
Case "AN"
icolor = 24
Case "SJ"
icolor = 26
Case "FG"
icolor = 27
Case "PH"
icolor = 28
Case Else
MsgBox ("Invalid teacher initials '" & TeacherInitials.Value & "' detected.")
End Select
CellToHighlight.Interior.ColorIndex = icolor
End If
End Sub

I can supply a copy of the Workbook if that helps, but not sure of the protocol.

Regards, Steve
</CODE>

 

[jbeaucaire]

How about adding a "color" column to your Staff worksheet where you put the icolor value for the initals in that row. Then you can use a "FIND" method in your macro to find the initials and set the cell color based on that. Then you won't be editing the macro anymore.

Option Explicit

Sub HighlightTextByTeacher(ByVal TeacherInitials As Range, ByVal CellToHighlight As Range)
Dim iFIND As Range

    If Not Intersect(TeacherInitials, Range("E4:E57,K4:K57")) Is Nothing Then
        On Error Resume Next
        Set iFIND = Sheets("Staff").Range("C:C").Find(TeacherInitials, LookIn:=xlValues, Lookat:=xlWhole)
        If Not iFIND Is Nothing Then
            CellToHighlight.Interior.ColorIndex = iFIND.Offset(, 1).Value
        Else
            MsgBox "These initials '" & TeacherInitials & "' were not found on the Staff Sheet."
        End If
    End If
End Sub

Any reason why this isn't written into a Worksheet_Change macro?

 

[steve.waye]

How about adding a "color" column to your Staff worksheet where you put the icolor value for the initals in that row. Then you can use a "FIND" method in your macro to find the initials and set the cell color based on that. Then you won't be editing the macro anymore.

Option Explicit
 
Sub HighlightTextByTeacher(ByVal TeacherInitials As Range, ByVal CellToHighlight As Range)
Dim iFIND As Range
 
    If Not Intersect(TeacherInitials, Range("E4:E57,K4:K57")) Is Nothing Then
        On Error Resume Next
        Set iFIND = Sheets("Staff").Range("C:C").Find(TeacherInitials, LookIn:=xlValues, Lookat:=xlWhole)
        If Not iFIND Is Nothing Then
            CellToHighlight.Interior.ColorIndex = iFIND.Offset(, 1).Value
        Else
            MsgBox "These initials '" & TeacherInitials & "' were not found on the Staff Sheet."
        End If
    End If
End Sub

Thanks. It all looks a bit advanced for me. Don't be fooled by my existing code. I didn't work it out myself from scratch. It's just something I cobbled together from things I found in forums like this. I'll give it a go though.

Any reason why this isn't written into a Worksheet_Change macro?

Yes. Because I've got no idea what a Worksheet_Change macro is.

 

[jbeaucaire]

My sample code presumed the INITIALs were in column C of the Staff page and you had put the iColor value in column D. In that way the macro simply looks up the initials in column C, finds the iColor value in D, then uses that to color the current row being evaluated.

 

[steve.waye]

My sample code presumed the INITIALs were in column C of the Staff page and you had put the iColor value in column D. In that way the macro simply looks up the initials in column C, finds the iColor value in D, then uses that to color the current row being evaluated.

Too easy. Thanks a lot.

 

[steve.waye]

Thanks jbeaucaire. You've been really helpful.

One last question (really).

I've decided to make the Colour column visible on the Staff sheet and have each cell's background colour change when the number is entered, to show the relevant colour.

The cell needs to go clear again if the number is deleted.

It will be necessary to change the text colour as well so the number can be clearly seen when the cell is highlighted. I assume I can do this by simply formatting the text in the cell as white text, although there might be a better reason to use VBA that I'm not aware of.

Steve

 

[jbeaucaire]

You could employ a WS_Change macro on that staff sheet. let's say the column where you're going to enter a "number" that is supposed to be interpreted by Excel as a "colorindex" and you want that cell to immediately be painted that color is column E.

1) Right-click the sheet tab and select VIEW CODE
2) Hopefully this module is empty, paste in this ws_change event macro:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
On Error GoTo ClearCell

    For Each cell In Target
        If Not Intersect(cell, Range("E:E")) Is Nothing Then
            If IsNumeric(cell.Value) Then
                cell.Interior.ColorIndex = cell.Value
            ElseIf cell.Value = "" Then
ClearCell:
                cell.Interior.ColorIndex = 0
            End If
        End If
    Next cell

End Sub

3) Close the editor and save your wb.
4) Try entering a number in column E anywhere.


This is just to show you how, of course you will adapt that to the correct column. Also, if your module isn't empty you will have to work out making this macro "play nice" with whatever else is already in the sheet module, and you can only have one ws_change macro per sheet. If there's one there already you'll have to merge them.

 

[steve.waye]

You could employ a WS_Change macro on that staff sheet. let's say the column where you're going to enter a "number" that is supposed to be interpreted by Excel as a "colorindex" and you want that cell to immediately be painted that color is column E.

1) Right-click the sheet tab and select VIEW CODE
2) Hopefully this module is empty, paste in this ws_change event macro:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
On Error GoTo ClearCell
 
    For Each cell In Target
        If Not Intersect(cell, Range("E:E")) Is Nothing Then
            If IsNumeric(cell.Value) Then
                cell.Interior.ColorIndex = cell.Value
            ElseIf cell.Value = "" Then
ClearCell:
                cell.Interior.ColorIndex = 0
            End If
        End If
    Next cell
 
End Sub

3) Close the editor and save your wb.
4) Try entering a number in column E anywhere.


This is just to show you how, of course you will adapt that to the correct column. Also, if your module isn't empty you will have to work out making this macro "play nice" with whatever else is already in the sheet module, and you can only have one ws_change macro per sheet. If there's one there already you'll have to merge them.

Have merged it with existing code and all is now complete and working great.

Thanks again for all of your help.

Regards, Steve