Forum Discussion
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
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, "@", "")
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- I try copy your code all is in red on my end
Workbook with my version of the macro attached...