Imported VBA code not working....

[HuskerBronco]

Hello all...

Last year, member rylo, helped me with some VBA code for one of my projects. If you are reading this post, rylo, you might recall the VBA code that you helped me with...and maybe you can help me once more. Otherwise, maybe some other members can help me.

The VBA code below was provided by rylo last year. The code was designed to cycle through a list of teams...and FILL the background of each cell in the list with color...depending on which named range a match was found in.

Sub SetNiteColor()
'AUTHOR:   rylo
'DATE: 2 Sep 2007
'REFERENCE: http://excelforum.com/showthread.php?t=612291
  
  'set default color for text
  Range("D5:R36").Font.ColorIndex = xlAutomatic
  'array of the night games defined names
  nitearr = Array("THURS_GAMES", "FRI_SAT_GAMES", "SUN_NITE_GAMES", "MON_NITE_GAMES")
  'cycle through all the relevant columns
  For coll = 4 To 18
    'determine color
    colorind = ""
  'set a reference for the date being processed
    Set findit = Sheets("sheet2").Range("E54:F112").Find(what:=Cells(4, coll), LookIn:=xlFormulas)
    If Not findit Is Nothing Then 'a match is found
    'cycle through the night arrays, and determine the relevant colorindex
      For i = LBound(nitearr) To UBound(nitearr)
        If Not Intersect(findit, Range(nitearr(i))) Is Nothing Then
      
          Select Case nitearr(i)
            Case "THURS_GAMES", "FRI_SAT_GAMES"
              colorind = 7
            Case "SUN_NITE_GAMES"
              colorind = 3
            Case "MON_NITE_GAMES"
              colorind = 5
          End Select
        
        End If
      Next i
    End If
    coloff = 1 'reference offset to get the team names for the date
    'used to determine the column to search for the team.  As there are 2 date columns, but
    'only one team column due to the merge, have to determine the relevant column
    If Not findit Is Nothing Then
      If coll Mod 2 = 0 Then
        teamcoll = coll
      Else
        teamcoll = coll - 1
      End If
    'find the team for the date, and set the font color
    Do
      Set findteam = Cells(5, teamcoll).Resize(32, 2).Find(what:=findit.Offset(0, coloff).Value, LookIn:=xlValues)
      If Not findteam Is Nothing Then
        findteam.Font.ColorIndex = colorind
      End If
      coloff = coloff + 2
    Loop Until IsEmpty(findit.Offset(0, coloff))
    End If
  Next coll
End Sub

This year I put together a slightly different spreadsheet and made the following changes to the VBA to conform to my new spreadsheet:

Sub SetNiteColor()
'AUTHOR:   rylo
'DATE: 2 Sep 2007
'REFERENCE: http://excelforum.com/showthread.php?t=612291
  
  'set default color for text
  Range("$E$5:$AR$36").Font.ColorIndex = xlAutomatic
  'array of the night games defined names
  nitearr = Array("ByeWeekTeams", "Th_Fr_Sa_Games", "MondayGames", "SundayGames")
  'cycle through all the relevant columns
  For coll = 5 To 43
    'determine color
    colorind = ""
  'set a reference for the date being processed
    Set findit = Sheets("sheet2").Range("F8:F73").Find(what:=Cells(5, coll), LookIn:=xlValues)
    If Not findit Is Nothing Then 'a match is found
    'cycle through the night arrays, and determine the relevant colorindex
      For i = LBound(nitearr) To UBound(nitearr)
        If Not Intersect(findit, Range(nitearr(i))) Is Nothing Then
      
          Select Case nitearr(i)
            Case "Th_Fr_Sa_Games"
              colorind = 9
            Case "ByeWeekTeams"
              colorind = 7
            Case "MondayGames"
              colorind = 5
            Case "SundayGames"
              colorind = 3
          End Select
        
        End If
      Next i
    End If
    coloff = 1 'reference offset to get the team names for the date
    'used to determine the column to search for the team.  As there are 2 date columns, but
    'only one team column due to the merge, have to determine the relevant column
    If Not findit Is Nothing Then
      If coll Mod 2 = 0 Then
        teamcoll = coll
      Else
        teamcoll = coll - 1
      End If
    'find the team for the date, and set the font color
    Do
      Set findteam = Cells(6, teamcoll).Resize(32, 2).Find(what:=findit.Offset(0, coloff).Value, LookIn:=xlValues)
      If Not findteam Is Nothing Then
        findteam.Font.ColorIndex = colorind
      End If
      coloff = coloff + 2
    Loop Until IsEmpty(findit.Offset(0, coloff))
    End If
  Next coll
End Sub

When I run the code, I get a Runtime error -' 1004': Method 'range' of object '_global' failed. (This error occurs on the VBA code line that is enlarged in the second version of the code, above. I tried to change the font color...but my color palette wouldn't open).

Three questions....

1. What part of the code did I change incorrectly? ...Or... Did I overlook any needed change(s)?

2. How can I format the font color along with the background color using this VBA?

3. The range $E$5:$AR$36 on sheet "MasterCopy" has been given a name.
Can't I replace the RANGE ($E$5:$AR$36) with the RANGE NAME ("Selections_MasterCopy")?

Thank you for any help you can provide....

[mikerickson]

The original code has two columns (E54:F112), the new version only one (F8:F73), might that be an issue?

[HuskerBronco]

The original code has two columns (E54:F112), the new version only one (F8:F73), might that be an issue?

The referenced columns contain dates.

In the older version, the dates appeared in merged cells.
The dates in the new version occupy individual cells.

[rylo]

Husker

Vaguely remember this. Can you attach an example workbook of your current structure with the new code.

rylo

[HuskerBronco]

Can you attach an example workbook of your current structure with the new code.

You bet I can.....!!!

But...don't have the time at the moment. (dammit...!!!)

Will get it to you as soon as I can. (Might be tomorrow....don't give up on me....)

[HuskerBronco]

Here is the truncated spreadsheet:

[rylo]

Hi

Took me a while!!!

Change the line

Set findit = Sheets("sheet2").Range("F8:F73").Find(what:=Cells(5, coll), LookIn:=xlValues)

to

Set findit = Sheets("sheet2").Range("F8:F73").Find(what:=Format(Cells(4, coll), Sheets("sheet2").Range("F8").NumberFormat), LookIn:=xlValues)

You will also have to get rid of the days in sheet2!G19:G27 and make them teams.

When you have done that, if you can't get it to work, then put up the revised workbook and I'll have another look.

rylo

[HuskerBronco]

Thanks, rylo....

I made the changes to the VBA code as suggested.

As far as the DAYS were concerned, I simply eliminated them, as I don't
really need them. Then I moved all of the teams one column to the left.

When I press the RANDOMIZE button on Sheet2...I get a Run-time error.

Run-time error '1004':
Unable to set the ColorIndex property of the Font Class


This error occurs AFTER your code changes...near the end of the subroutine;

    'find the team for the date, and set the font color
    Do
      Set findteam = Cells(6, teamcoll).Resize(32, 2).Find(what:=findit.Offset(0, coloff).Value, LookIn:=xlValues)
      If Not findteam Is Nothing Then
        findteam.Font.ColorIndex = colorind
      End If
      coloff = coloff + 2
    Loop Until IsEmpty(findit.Offset(0, coloff))
    End If
  Next coll
End Sub

Also, is there a simple way to add code to set the FONT for each CASE above??

I've attached the updated sample for your inspection.
Thanks, so much, for your help...

[rylo]

Hi

Instead of actioning a range that has teams, you are going from column 5 to column 43 and this range included blank columns (21-23). It is having trouble establishing a value for colorind in the case statement.

Perhaps enhance the case statement to have a default colorind of say xlnone. See how that goes.


rylo

[HuskerBronco]

I'm going to try that......

Or....Maybe is should just execute the procedure TWICE....once for each half of the range...........????????