Forum Discussion
sf49ers19238597
Sep 10, 2023Iron Contributor
I have nfl grid schedule. I press button to put team schedule on own worksheet is error in vba code
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
sf49ers19238597
Sep 10, 2023Iron Contributor
which worksheet you mean?
HansVogelaar
Sep 10, 2023MVP
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.
- sf49ers19238597Sep 10, 2023Iron Contributor
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
- HansVogelaarSep 11, 2023MVP
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, "@", "") Else .Cells(r, 3).Value = "HOME" End If Next r .Columns.AutoFit End With Next i .Columns.AutoFit: .Parent.Activate End With Application.ScreenUpdating = True End Sub
- sf49ers19238597Sep 11, 2023Iron ContributorI try copy your code all is in red on my end