I have nfl grid schedule. I press button to put team schedule on own worksheet is error in vba code

Iron Contributor

I have nfl grid schedule. I press football icon  button to put team schedule on own worksheet stop at colts worksheet.  is error in vba code

11 Replies


After deleting the existing sheets named after teams, your macro ran without errors.


The sheets named 49ERS, BEARS, BENGALS etc. - in other words, the ones whose name is listed in column B of the TEAMS sheet. The code creates a new sheet for each of these names, but if a sheet of that name already exists, you'll get an error.

@Hans Vogelaar 


I just got it work now.


How change code.

How I put @ in column C than put AWAY instead of @.


If no @ in column C. put HOME.


Than remove @ in column B.

for all 32 teams own worksheets.


Bills Sample is should column C look like. I still have @ in column B





Sub J3v16()
    Dim Data, Team, Chk, Hdr, i As Long, r As Long
    Dim w As Worksheet
    Application.ScreenUpdating = False
    Data = Sheets("Teams").Cells(1).CurrentRegion
    Hdr = Array("WEEKS", "OPPONENTS", "AWAY OR HOME")
    With Sheets("Transposes").Cells(1).CurrentRegion
        .Replace "@", "'@"
        For i = 1 To UBound(Data)
            .Replace Data(i, 1), Data(i, 2), xlWhole
            .Replace "*" & Data(i, 1), "@" & Data(i, 2), xlWhole
        Next i
        For i = 1 To UBound(Data)
            Chk = Application.Match(Data(i, 2), .Rows(1), 0)
            Team = .Cells(1, Chk).Offset(1).Resize(18).Value
            On Error Resume Next
            Set w = Worksheets(Data(i, 2))
            On Error GoTo 0
            If w Is Nothing Then
                Set w = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                w.Name = Data(i, 2)
                w.Cells(1, 1).Resize(, 3) = Hdr
                w.Cells(2, 1).Resize(18) = Evaluate("Row(1:18)")
            End If
            With w
                .Cells(2, 2).Resize(18) = Team
                For r = 2 To 19
                    If InStr(.Cells(r, 2).Value, "@") Then
                        .Cells(r, 3).Value = "AWAY"
                        .Cells(r, 2).Value = Replace(.Cells(r, 2).Value, "@", "")
                        .Cells(r, 3).Value = "HOME"
                    End If
                Next r
            End With
        Next i
        .Columns.AutoFit: .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub
I try copy your code all is in red on my end


Workbook with my version of the macro attached...

@Hans Vogelaar 


I saw you done one team only. How get rest of 31 teams schedule?

@Hans Vogelaar 



 I put new code in. I run the macro by press football icon only give me bills only.


I  attach file you can see. 


My apologies, I omitted one line from the code.