Just looking for criticism

adsxvii

adsxvii

Board Regular
Joined
Mar 15, 2007
Messages
213
I am still pretty new to programming but make useful programs, but I am always looking to get better. My code never seems to look like other peoples code I see post, so I am just looking for people to tell me what I am doing wrong. I chose the following code because it looks worse than usual. Here goes
Code: 
'-------------------------------------------------------------------'
Sub DivRecord()

Dim j As Byte
Dim i As Byte
Dim GetNames As Byte
Dim TeamName(1 To 4) As String
Dim OppColNdx(1 To 6) As Integer
Dim a As Byte
Dim b As Byte
Dim c As Byte
Dim d As Byte
Dim GetWins As Byte
Dim Wins As Byte
Dim TeamRowNdx As Byte

        For i = 4 To 32 Step 4
        
            Sheets("Results").Select
            
            For GetNames = 1 To 4
            
                    TeamName(GetNames) = Range("C" & i - 1 + GetNames)
                    
            Next GetNames
                       
            For GetWins = 1 To 4
            
                Wins = 0
                
                If GetWins = 1 Then
                
                    a = 1
                    b = 2
                    c = 3
                    d = 4
                    
                End If
                
                If GetWins = 2 Then
                
                    a = 2
                    b = 1
                    c = 3
                    d = 4
                    
                End If
                
                If GetWins = 3 Then
                
                    a = 3
                    b = 2
                    c = 1
                    d = 4
                    
                End If
                
                If GetWins = 4 Then
                
                    a = 4
                    b = 2
                    c = 3
                    d = 1
                    
                End If
          
                Sheets("Schedule").Select
                Range("B3:B35").Select
                TeamRowNdx = Selection.Find(What:=TeamName(a), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
                Rows(TeamRowNdx).Select
                OppColNdx(1) = Selection.Find(What:=TeamName(b), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(1)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(2) = Selection.Find(What:=TeamName(b), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Rows(TeamRowNdx).Select
                OppColNdx(3) = Selection.Find(What:=TeamName(c), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(3)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(4) = Selection.Find(What:=TeamName(c), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                            Rows(TeamRowNdx).Select
                OppColNdx(5) = Selection.Find(What:=TeamName(d), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(5)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(6) = Selection.Find(What:=TeamName(d), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                                
                For j = 1 To 6
                
                    If Cells(TeamRowNdx, OppColNdx(j)) = "W" Then Wins = Wins + 1
                    
                Next j
                
                Sheets("Results").Range("I" & i - 1 + GetWins) = Wins
                
            Next GetWins
            
        Next i
        
        Sheets("Results").Select
        
End Sub
This is part of a big program but can run on its own too FWIW.
Also not really that sure on naming variables dont usually name them a, b, c, and d like here just seemed easy.
The whole program is here feel free to give any advice :)
Code: 
Option Explicit
'-------------------------------------------------------------------'
Sub SimSeason()

Dim Week As Byte
Dim TempLoop As Byte
Dim i As Byte
Dim TeamLoop As Byte
Dim OppNameNdx As Byte
Dim ColNdx As Integer
Dim SeasonWins() As Byte
Dim SeasonWinTotals(4 To 35) As Long
Dim UserSims As Integer
Dim Simulations As Long
Dim TeamRank As Variant
Dim OppRank As Variant
Dim Random As Variant
Dim NewOppRank As Variant
Dim NewTeamRank As Variant
Dim NewRank As Variant
Dim Log5 As Variant
Dim HomeField As Variant
Dim TempTeam As String
Dim TeamNames(4 To 35) As String
Dim Site As String
Dim OppName As String
Dim DivNames(4 To 35) As String
Dim TeamNdx As Byte
Dim TeamOppList(4 To 35, 1 To 17) As String
Dim TotalDivWins(4 To 35) As Long
Dim NFCWinner As String
Dim AFCWinner As String
Dim BowlWinner As String
Dim ConfWins(4 To 35) As Long
Dim BowlWins(4 To 35) As Long

    Sheets("Results").Select
    Application.ScreenUpdating = False
    
'see how simulations user wants to run

    UserSims = Range("C37")
    
'outside loop just repeating the sims

    For Simulations = 1 To UserSims
    
        Call FillFormulas
      
'reset all wins to 0
        
        ReDim SeasonWins(4 To 35) As Byte
        
'clean up the last sims data
      
        Sheets("Schedule").Select
        
        
        For Week = 1 To 17
            
            ColNdx = 4 + (Week - 1) * 6
            Range(Cells(4, ColNdx + 4), Cells(35, ColNdx + 5)).ClearContents
            
        Next Week
        
'set homefield
    
        HomeField = 0.09
    
'this starts a loop that goes week by week and fills in the results
    
        For Week = 1 To 17
                    
            ColNdx = 4 + (Week - 1) * 6
            
'this starts the loop for each team
    
            For TeamLoop = 4 To 35
            
                TeamNames(TeamLoop) = Range("B" & TeamLoop)
          
'pull in all the variable data
                
                If Cells(TeamLoop, ColNdx + 4) <> "" Or Cells(TeamLoop, ColNdx + 1) = "" Then GoTo skiptohere
                
                TeamRank = Cells(TeamLoop, ColNdx - 1)
                OppName = Cells(TeamLoop, ColNdx + 1)
                OppRank = Cells(TeamLoop, ColNdx + 2)
                Random = Rnd
                
'calculates log5 for home and away
    
                If Cells(TeamLoop, ColNdx) = "A" Then
                
                    Log5 = ((TeamRank - TeamRank * OppRank) / (TeamRank + OppRank - 2 * TeamRank * OppRank)) - HomeField
                
                Else
                
                    Log5 = ((TeamRank - TeamRank * OppRank) / (TeamRank + OppRank - 2 * TeamRank * OppRank)) + HomeField
                
                End If
                
'calc what to add to rank
    
                NewRank = ((0.75 - Log5) * 0.04)

                If NewRank < 0 Then NewRank = 0
                If NewRank > 2 Then NewRank = 2
                
'looks at win/loss in regards to random number and outputs result also calcs new Ranks
    
                If Random > Log5 Then
                
                    Cells(TeamLoop, ColNdx + 4) = "L"
                    NewTeamRank = TeamRank - (0.02 - NewRank)
                    NewOppRank = OppRank + (0.02 - NewRank)
                    
                Else
                
                    Cells(TeamLoop, ColNdx + 4) = "W"
                    NewTeamRank = TeamRank + NewRank
                    NewOppRank = OppRank - NewRank
                    
                End If
    
'outputs new ranks

                Range("B3:B35").Select
                OppNameNdx = Selection.Find(What:=OppName, After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
                Cells(OppNameNdx, ColNdx + 5) = NewOppRank
                Cells(TeamLoop, ColNdx + 5) = NewTeamRank
                
                If Cells(TeamLoop, ColNdx + 4) = "W" Then
                
                    Cells(OppNameNdx, ColNdx + 4) = "L"
                    
                Else
                
                    Cells(OppNameNdx, ColNdx + 4) = "W"
                    
                End If
skiptohere:
    
            Next TeamLoop
            
            For TeamNdx = 4 To 35
            
              If Cells(TeamNdx, ColNdx + 5) = "" Then Cells(TeamNdx, ColNdx + 5) = Cells(TeamNdx, ColNdx - 1)
              
            Next TeamNdx
            
        Next Week
        
'add up the season wins and also the totalwins over the sim and assemble a opponent array

        For TeamNdx = 4 To 35
        
            For Week = 1 To 17
            
                TeamOppList(TeamNdx, Week) = Cells(TeamNdx, 5 + ((Week - 1) * 6))
                
                If Cells(TeamNdx, 2 + Week * 6) = "W" Then
                
                    SeasonWins(TeamNdx) = SeasonWins(TeamNdx) + 1
                    
                End If
                
            Next Week
            
            SeasonWinTotals(TeamNdx) = SeasonWinTotals(TeamNdx) + SeasonWins(TeamNdx)
            
        Next TeamNdx
                       
'put season wins into division to help figure out playoff spots

        Sheets("Results").Select
        
        For TempLoop = 4 To 35
        
            TempTeam = Range("C" & TempLoop)
            DivNames(TempLoop) = TempTeam
            
            For i = 4 To 35
            
                If TempTeam = TeamNames(i) Then
                
                    Range("D" & TempLoop) = SeasonWins(i)
                    Range("K" & TempLoop) = SeasonWinTotals(i) / Simulations
                    
                End If
                
            Next i
            
        Next TempLoop
        
'calculate Division records
        
        Call DivRecord
        
'calculate Conference record

        Call ConfRecord
        
'if there are ties in any of the divisions this will fix them
        
        If Application.Sum(Range("G4:G35")) > 8 Then
        
            Call DivTies(TeamOppList(), TeamNames(), DivNames(), SeasonWins())
            
        Else
        
            Range("H4:H35").Value = Range("F4:F35").Value
            
        End If
        
'seed the teams for the playoff spots

        Call SeedTeams
        
'count up the season divisional winners and keep a running total
        
        For i = 4 To 35
    
            If Range("H" & i) = 1 Then
            
                TeamNdx = TeamNumber(Range("C" & i), TeamNames())
                TotalDivWins(TeamNdx) = TotalDivWins(TeamNdx) + 1
                
            End If
        
        Next i
        
'print the running total to user

        For TempLoop = 4 To 35
        
            TempTeam = Range("C" & TempLoop)
            
            For i = 4 To 35
            
                If TempTeam = TeamNames(i) Then
                
                    Range("L" & TempLoop) = TotalDivWins(i) / Simulations
                    
                End If
                
            Next i
            
        Next TempLoop
        
'collect the winners of the playoff conf and bowl games
        
        NFCWinner = Range("AL11")
        AFCWinner = Range("AL7")
        BowlWinner = Range("AM11")
        
'keep a running total of conf and bowl winners

        For i = 4 To 35
        
            If DivNames(i) = AFCWinner Then ConfWins(i) = ConfWins(i) + 1
            If DivNames(i) = NFCWinner Then ConfWins(i) = ConfWins(i) + 1
            If DivNames(i) = BowlWinner Then BowlWins(i) = BowlWins(i) + 1
            
        Next i
        
'print to user the conf and bowl %'s

        For i = 4 To 35
        
            Range("M" & i) = ConfWins(i) / Simulations
            Range("N" & i) = BowlWins(i) / Simulations
                
        Next i
        
'update % of sim done
                
        Application.ScreenUpdating = True
        Range("C38") = Simulations / UserSims
        Application.ScreenUpdating = False
        
    Next Simulations
    
End Sub
'-------------------------------------------------------------------'
Sub SeedTeams()

Dim Conf As Byte
Dim strConf As String
Dim RowNdx As Byte
Dim Seed As Byte
Dim ConfWild As Byte
Dim LimitCount As Byte
Dim AddToSeed As Byte

    For ConfWild = 1 To 2
            
        If ConfWild = 1 Then
            
            LimitCount = 3
            AddToSeed = 1
            
        Else
        
            LimitCount = 1
            AddToSeed = 5
            
        End If
                
        For Conf = 1 To 2
        
            If Conf = 1 Then
            
                strConf = "AFC"
                
            Else
            
                strConf = "NFC"
                
            End If
            
            ActiveSheet.Range("$A$3:$N$35").AutoFilter Field:=1, Criteria1:=strConf
            ActiveWorkbook.Worksheets("Results").AutoFilter.Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Results").AutoFilter.Sort.SortFields.Add Key:= _
                Range("L3:L35"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
                :=xlSortNormal
            With ActiveWorkbook.Worksheets("Results").AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            ActiveWorkbook.Worksheets("Results").AutoFilter.Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Results").AutoFilter.Sort.SortFields.Add Key:= _
                Range("J3:J35"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
                :=xlSortNormal
            With ActiveWorkbook.Worksheets("Results").AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            ActiveWorkbook.Worksheets("Results").AutoFilter.Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Results").AutoFilter.Sort.SortFields.Add Key:= _
                Range("D3:D36"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
                :=xlSortNormal
            With ActiveWorkbook.Worksheets("Results").AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            If ConfWild = 1 Then
                
                ActiveSheet.Range("$A$3:$N$36").AutoFilter Field:=8, Criteria1:="<>"
                
            Else
            
                ActiveSheet.Range("$A$3:$N$36").AutoFilter Field:=8, Criteria1:="="
            
            End If
            
            Seed = 0
            
            For RowNdx = 4 To 35
                
                If Rows(RowNdx).Hidden = False Then
                
                    Range("N" & RowNdx) = Seed + AddToSeed
                    Seed = Seed + 1
                 
                End If
                    
                    If Seed > LimitCount Then Exit For
                    
            Next RowNdx
    
            Call ClearFilters
            
        Next Conf
        
    Next ConfWild
    
End Sub
'-------------------------------------------------------------------'
Sub ClearFilters()

        Range("A4:N35").Select
        Selection.AutoFilter
        
        ActiveWorkbook.Worksheets("Results").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Results").Sort.SortFields.Add Key:=Range("M4:M35") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Results").Sort
            .SetRange Range("A4:N35")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
End Sub
'-------------------------------------------------------------------'
Sub DivTies(TeamOppList() As String, TeamNames() As String, DivNames() As String, SeasonWins() As Byte)

Dim TeamCount As Byte
Dim TeamRowNdx As Byte
Dim FindTeams As Byte
Dim OppWeek As Byte
Dim DivisionTies As Byte
Dim TieTeamNumber As Byte
Dim OppNum As Byte
Dim TeamNdx As Byte
Dim Week As Byte
Dim DivRecord(1 To 2) As Byte
Dim ConfRecord(1 To 2) As Byte
Dim CompareWins(1 To 2) As Byte
Dim i As Byte
Dim j As Byte
Dim k As Byte
Dim TiedTeam(1 To 2) As String
Dim TeamColNdx(1 To 2) As Integer
Dim CompareTeams(1 To 2, 1 To 17) As Variant
Dim ResultOfCompare(1 To 2, 1 To 17) As Variant
Dim TempOpp As String
Dim Random As Variant
Dim OppWins(1 To 2)
Dim OppThisWeek As String
Dim CoinFlipTeam As Byte
Dim ThreeTiedTeam(1 To 3) As String

'step thru the first row in each division where it shows if there are any tied teams

    For i = 4 To 32 Step 4
    
        Sheets("Results").Select
               
'if there are teams tied

        If Range("G" & i) > 1 Then
            
            TeamCount = 1
            DivisionTies = Range("G" & i)

'for 4 ties we just do random number and eliminate 1

            If DivisionTies = 4 Then
                
                Random = Rnd
                
                If Random <= 0.25 Then CoinFlipTeam = 1
                If Random > 0.25 And Random <= 0.5 Then CoinFlipTeam = 2
                If Random > 0.5 And Random <= 0.75 Then CoinFlipTeam = 3
                If Random > 0.75 Then CoinFlipTeam = 4
                
                Range("F" & i - 1 + CoinFlipTeam) = ""
                DivisionTies = 3
                
            End If
            
'for 3 ties we just do random number and eliminate 1
'MAY CHANGE LATER THATS WHY DIDNT JUST GO FROM 4 TO 2 IN LAST SECTION
            
            If DivisionTies = 3 Then
            
                Random = Rnd
                
                If Random <= 0.3333 Then CoinFlipTeam = 1
                If Random > 0.33333 And Random <= 0.666667 Then CoinFlipTeam = 2
                If Random > 0.666667 Then CoinFlipTeam = 3
                
                For FindTeams = i To i + 3
                    
                    If Range("F" & FindTeams) = 1 Then
                    
                        ThreeTiedTeam(TeamCount) = Range("C" & FindTeams)
                        TeamCount = TeamCount + 1
                        
                    End If
                    
                Next FindTeams
                
                Range("C3:C35").Select
                TeamRowNdx = Selection.Find(What:=ThreeTiedTeam(CoinFlipTeam), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
                Range("F" & TeamRowNdx) = ""
                TeamCount = 1
                DivisionTies = 2
            
            End If

'if there are 2 teams tied

            If DivisionTies = 2 Then
            
                For FindTeams = i To i + 3
                    
                    If Range("F" & FindTeams) = 1 Then
                    
                        TiedTeam(TeamCount) = Range("C" & FindTeams)
                        DivRecord(TeamCount) = Range("I" & FindTeams)
                        ConfRecord(TeamCount) = Range("J" & FindTeams)
                        TeamCount = TeamCount + 1
                        
                    End If
                    
                Next FindTeams
                
'check for head to head

                Sheets("Schedule").Select
                Range("B3:B35").Select
                TeamRowNdx = Selection.Find(What:=TiedTeam(1), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
                Rows(TeamRowNdx).Select
                TeamColNdx(1) = Selection.Find(What:=TiedTeam(2), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, TeamColNdx(1)), Cells(TeamRowNdx, 200)).Select
                TeamColNdx(2) = Selection.Find(What:=TiedTeam(2), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                            
                If Cells(TeamRowNdx, TeamColNdx(1)) = "W" Then
                
                    If Cells(TeamRowNdx, TeamColNdx(2)) = "W" Then
                    
                        Call TeamWinner(TiedTeam(), 1, 2)
                        GoTo Pass_To_Next
                        
                    End If
                    
                End If
                
                If Cells(TeamRowNdx, TeamColNdx(1)) = "L" Then
                
                    If Cells(TeamRowNdx, TeamColNdx(2)) = "L" Then
                    
                        Call TeamWinner(TiedTeam(), 2, 1)
                        GoTo Pass_To_Next
                        
                    End If
                    
                End If
                
'check for divisional win edge

                If DivRecord(1) > DivRecord(2) Then
                
                    Call TeamWinner(TiedTeam(), 1, 2)
                    GoTo Pass_To_Next
                    
                End If
                
                If DivRecord(1) < DivRecord(2) Then
                
                    Call TeamWinner(TiedTeam(), 2, 1)
                    GoTo Pass_To_Next
                    
                End If
                
'check for common games those other than division
             
                For j = 1 To 2
                
                    Range("B3:B35").Select
                    TeamRowNdx = Selection.Find(What:=TiedTeam(j), After:=ActiveCell, LookIn:=xlFormulas, _
                                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False).Row
                    Rows(TeamRowNdx).Select
                    
                    For Week = 1 To 17
                    
                        CompareTeams(j, Week) = Cells(TeamRowNdx, 5 + (Week - 1) * 6)
                        ResultOfCompare(j, Week) = Cells(TeamRowNdx, 8 + (Week - 1) * 6)
                        
                    Next Week
                    
                Next j
                
                For Week = 1 To 17
                
                    TempOpp = CompareTeams(1, Week)
                    
                    For OppWeek = 1 To 17
                    
                        If TempOpp = CompareTeams(2, OppWeek) Then
                        
                            If ResultOfCompare(1, Week) = "W" Then CompareWins(1) = CompareWins(1) + 1
                            If ResultOfCompare(2, OppWeek) = "W" Then CompareWins(2) = CompareWins(2) + 1
                            
                        End If
                        
                    Next OppWeek
                    
                Next Week
                
                If CompareWins(1) > CompareWins(2) Then
                
                    Call TeamWinner(TiedTeam(), 1, 2)
                    GoTo Pass_To_Next
                    
                End If
                
                If CompareWins(1) < CompareWins(2) Then
                
                    Call TeamWinner(TiedTeam(), 2, 1)
                    GoTo Pass_To_Next
                    
                End If
                
'check for conference record
                
                If ConfRecord(1) > ConfRecord(2) Then
                
                    Call TeamWinner(TiedTeam(), 1, 2)
                    GoTo Pass_To_Next
                    
                End If
                
                If ConfRecord(1) < ConfRecord(2) Then
                
                    Call TeamWinner(TiedTeam(), 2, 1)
                    GoTo Pass_To_Next
                    
                End If
                
'determine win strength by win percentage of teams they beat

                        
                For j = 1 To 2

                    For Week = 1 To 17
                                    
                        TieTeamNumber = TeamNumber(TiedTeam(j), TeamNames())
                        OppThisWeek = TeamOppList(TieTeamNumber, Week)
                        
                        If OppThisWeek = "" Then GoTo bye_week
                        
                        OppNum = TeamNumber(OppThisWeek, TeamNames())
                        OppWins(j) = OppWins(j) + SeasonWins(OppNum)
bye_week:
                    Next Week
                    
                Next j
                                
                If OppWins(1) > OppWins(2) Then
                
                    Call TeamWinner(TiedTeam(), 1, 2)
                    GoTo Pass_To_Next
                    
                End If
                
                If OppWins(1) < OppWins(2) Then
                
                    Call TeamWinner(TiedTeam(), 2, 1)
                    GoTo Pass_To_Next
                    
                End If
                
'if still ties its down to a coin flip using rand() in A2 on Schedule Page

                If Rnd < 0.5 Then
                
                    Call TeamWinner(TiedTeam(), 1, 2)
                    
                Else
                
                    Call TeamWinner(TiedTeam(), 2, 1)
                    
                End If
                
            End If
            
        Else
        
            Range("H" & i & ":H" & i + 3).Value = Range("F" & i & ":F" & i + 3).Value
            
        End If
        
Pass_To_Next:

    Next i
    
End Sub
'-------------------------------------------------------------------'
Sub DivRecord()

Dim j As Byte
Dim i As Byte
Dim GetNames As Byte
Dim TeamName(1 To 4) As String
Dim OppColNdx(1 To 6) As Integer
Dim a As Byte
Dim b As Byte
Dim c As Byte
Dim d As Byte
Dim GetWins As Byte
Dim Wins As Byte
Dim TeamRowNdx As Byte

        For i = 4 To 32 Step 4
        
            Sheets("Results").Select
            
            For GetNames = 1 To 4
            
                    TeamName(GetNames) = Range("C" & i - 1 + GetNames)
                    
            Next GetNames
                       
            For GetWins = 1 To 4
            
                Wins = 0
                
                If GetWins = 1 Then
                
                    a = 1
                    b = 2
                    c = 3
                    d = 4
                    
                End If
                
                If GetWins = 2 Then
                
                    a = 2
                    b = 1
                    c = 3
                    d = 4
                    
                End If
                
                If GetWins = 3 Then
                
                    a = 3
                    b = 2
                    c = 1
                    d = 4
                    
                End If
                
                If GetWins = 4 Then
                
                    a = 4
                    b = 2
                    c = 3
                    d = 1
                    
                End If
          
                Sheets("Schedule").Select
                Range("B3:B35").Select
                TeamRowNdx = Selection.Find(What:=TeamName(a), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
                Rows(TeamRowNdx).Select
                OppColNdx(1) = Selection.Find(What:=TeamName(b), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(1)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(2) = Selection.Find(What:=TeamName(b), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Rows(TeamRowNdx).Select
                OppColNdx(3) = Selection.Find(What:=TeamName(c), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(3)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(4) = Selection.Find(What:=TeamName(c), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                            Rows(TeamRowNdx).Select
                OppColNdx(5) = Selection.Find(What:=TeamName(d), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(5)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(6) = Selection.Find(What:=TeamName(d), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                                
                For j = 1 To 6
                
                    If Cells(TeamRowNdx, OppColNdx(j)) = "W" Then Wins = Wins + 1
                    
                Next j
                
                Sheets("Results").Range("I" & i - 1 + GetWins) = Wins
                
            Next GetWins
            
        Next i
        
        Sheets("Results").Select
        
End Sub
'-------------------------------------------------------------------'
Sub ConfRecord()

Dim j As Byte
Dim i As Byte
Dim a As Byte
Dim GetNames As Byte
Dim TeamName(1 To 32) As String
Dim OppColNdx As Byte
Dim GetWins As Byte
Dim Wins As Byte
Dim TeamRowNdx As Byte
Dim TempSearch As Range
Dim Start As Byte

        Sheets("Results").Select
        
        For GetNames = 4 To 35
        
                TeamName(GetNames - 3) = Range("C" & GetNames)
                
        Next GetNames
    
        Sheets("Schedule").Select
        
        For i = 1 To 32
        
            Wins = 0
            Range("B3:B35").Select
            TeamRowNdx = Selection.Find(What:=TeamName(i), After:=ActiveCell, LookIn:=xlFormulas, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False).Row
                        
            If i < 17 Then Start = 17 Else Start = 1
            
            For j = Start To Start + 15
            
                Rows(TeamRowNdx).Select
                Set TempSearch = Selection.Find(What:=TeamName(j), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                            
                If Not TempSearch Is Nothing Then
                
                    OppColNdx = Selection.Find(What:=TeamName(j), After:=ActiveCell, LookIn:=xlFormulas, _
                                LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False).Column + 3
                    If Cells(TeamRowNdx, OppColNdx) = "W" Then Wins = Wins + 1
                    
                End If
                
            Next j
            
            Sheets("Results").Range("J" & i + 3) = Sheets("Results").Range("D" & i + 3) - Wins
            
        Next i
            
        Sheets("Results").Select
        
End Sub
'-------------------------------------------------------------------'
Function TeamNumber(TiedTeam As String, TeamNames() As String)

Dim i As Integer

    For i = 4 To 35
    
        If TiedTeam = TeamNames(i) Then Exit For

    Next i
    
    TeamNumber = i
    
End Function
'-------------------------------------------------------------------'
Sub TeamWinner(TiedTeam, a As Byte, b As Byte)

Dim TeamRowNdx

        Sheets("Results").Select
        Range("C3:C35").Select
        
        TeamRowNdx = Selection.Find(What:=TiedTeam(a), After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Row
        Range("H" & TeamRowNdx) = 1
        
        TeamRowNdx = Selection.Find(What:=TiedTeam(b), After:=ActiveCell, LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Row
        Range("F" & TeamRowNdx) = ""
        
End Sub
'-------------------------------------------------------------------'
Sub FillFormulas()

Dim i As Byte

    Range("D4:N36").ClearContents

    For i = 4 To 32 Step 4
        
        Range("G" & i).FormulaR1C1 = "=IF(RC[-3]="""","""",SUM(RC[-1]:R[3]C[-1]))"
        Range("E" & i).FormulaR1C1 = "=IF(RC[-1]="""","""",LARGE(R" & i & "C[-1]:R" & i + 3 & "C[-1],1))"
        Range("F" & i).FormulaR1C1 = "=IF(RC[-2]="""","""",IF(RC[-2]<R" & i & "C[-1],"""",1))"
        Range("E" & i & ":F" & i).AutoFill Destination:=Range("E" & i & ":F" & i + 3), Type:=xlFillDefault
        
    Next i

    Range("L4").FormulaR1C1 = "=RAND()"
    Range("L4").AutoFill Destination:=Range("L4:L35"), Type:=xlFillDefault
    Range("L4:L35").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("M4") = 1
    Range("M5") = 2
    Range("M4:M5").AutoFill Destination:=Range("M4:M35"), Type:=xlFillDefault
    
End Sub
It cut a small amount of the end off but nothing important.
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Sort by date Sort by votes
It's a big ask to have people try to improve your code when they have no idea of how data is laid out in the various sheets. You may get some general advice (use Option Explicit, use a variable naming convention, try to avoid Selecting and the like), but I doubt you'd get specific advice. You're asking them to look at your existing code and work out what it does, with only blank sheets in fron of them - and THEN improve it.

Two things you could do:
1. I know you can't attach files here, but you could put such a file on the web somewhere and provide a link to it.

2. Give some commentary about what the code does or better, what you want it to do.

You're much more likely to get a response.
 
Upvote 0
One thing you want to do to make your code run much faster is to eliminate all the .Select lines of code. You don't have to select a cell or range of cells before doing something to it. You can reference the cells directly without selecting them.

I don't know how your data is set up on Sheets("Schedule"), but to get the wins for a given team, could you just count all the "W"s in a TeamRowNdx?

Example:
Wins = WorksheetFunction.CountIf(Sheets("Schedule").Rows(TeamRowNdx), "W")
 
Upvote 0
If you use more than one sheet, be careful to qualify what sheets you are working with - once you remove Selects, you won't be able to take for granted "what" sheet you are on. Alphafrog is correct in showing you how to fully qualify the ranges so selection is not needed - so I just want to reinforce the importance of using fully qualified references for all ranges in the code once you start to introduce these changes.

The instructions below give an example of using With/End blocks - these are very common in hand-written code, to make it more compact (and readable):

From: http://www.techbookreport.com/tutorials/excel_vba3.html
With - End With

Although it's not a loop command, the With statement is extremely useful to know and can make your coding both simpler to understand and save on the drudgery of typing out long statements again and again. The With statement allows you to set up a reference to an object once and then to re-use that reference repeatedly without having to type it all in again. For example, if we want to address a particular cell on a worksheet we would have to refer to it as:

ActiveSheet.Range("A1")

If we now wanted to set the value, the font type and font size for this cell we could use the With statement as shown below:

With ActiveSheet.Range("A1")
.Value=12
.Font.Italic = True
.Font.Size = 14
End With

Given that references can become extremely verbose at times, the With End With statements should always be used to make your code easier to follow.
Click to expand...

Applying this to a snippet from your code we can get:
Code: 
'clean up the last sims data
      
        [COLOR="Blue"]With[/COLOR] Sheets("Schedule")
        
            For Week = 1 To 17
            
                ColNdx = 4 + (Week - 1) * 6
                .Range(.Cells(4, ColNdx + 4), .Cells(35, ColNdx + 5)).ClearContents
            
            Next Week

        [COLOR="Blue"]End With[/COLOR]

Note that we have dotted the Range -- .Range -- and Cells -- .Cells -- inside the with block.
 
Last edited:
Upvote 0
Thank you for your answers. I will try to get it on a website. Also the .select thing is a big help I will change my code using that. Thanks again. Also I changed the first sub to this I think looks better.
Code: 
'-------------------------------------------------------------------'
Sub DivRecord()

Dim j As Byte
Dim i As Byte
Dim GetNames As Byte
Dim TeamName(1 To 4) As String
Dim OppColNdx(1 To 6) As Integer
Dim a As Byte
Dim b As Byte
Dim c As Byte
Dim d As Byte
Dim GetWins As Byte
Dim Wins As Byte
Dim TeamRowNdx As Byte

'step thru each division

        For i = 4 To 32 Step 4
        
            Sheets("Results").Select
            
'get name of teams in each division

            For GetNames = 1 To 4
            
                    TeamName(GetNames) = Range("C" & i - 1 + GetNames)
                    
            Next GetNames
                       
'set conditions for each team


            For GetWins = 1 To 4
            
                Wins = 0
                
                Select Case GetWins
                
                    Case 1
                    
                        a = 1: b = 2: c = 3: d = 4
                        
                    Case 2
                    
                        a = 2: b = 1: c = 3: d = 4
                        
                    Case 3
                    
                        a = 3: b = 2: c = 1: d = 4
                        
                    Case 4
                    
                        a = 4: b = 2: c = 3: d = 1
                        
                End Select
          
'find w/l all 3 opp 6 total games

                Sheets("Schedule").Select
                Range("B3:B35").Select
                TeamRowNdx = Selection.Find(What:=TeamName(a), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
                Rows(TeamRowNdx).Select
                OppColNdx(1) = Selection.Find(What:=TeamName(b), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(1)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(2) = Selection.Find(What:=TeamName(b), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Rows(TeamRowNdx).Select
                OppColNdx(3) = Selection.Find(What:=TeamName(c), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(3)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(4) = Selection.Find(What:=TeamName(c), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                            Rows(TeamRowNdx).Select
                OppColNdx(5) = Selection.Find(What:=TeamName(d), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                Range(Cells(TeamRowNdx, OppColNdx(5)), Cells(TeamRowNdx, 200)).Select
                OppColNdx(6) = Selection.Find(What:=TeamName(d), After:=ActiveCell, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Column + 3
                                
'add up the win/loss record

                For j = 1 To 6
                
                    If Cells(TeamRowNdx, OppColNdx(j)) = "W" Then Wins = Wins + 1
                    
                Next j
                
                Sheets("Results").Range("I" & i - 1 + GetWins) = Wins
                
            Next GetWins
            
        Next i
        
        Sheets("Results").Select
        
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Excel macros extremely slow
Replies
4
Views
188
Shloime
S
P
  • Solved
Add an IF Statement
2
Replies
10
Views
371
Joe4
Joe4
M
  • Question
Excel VBA Set Activecell Formula With String
Replies
1
Views
456
Special-K99
S
M
  • Locked
  • Question
Sumproduct Formula in VBA
Replies
3
Views
490
Fluff
Fluff
A
  • Question
Select range using Endx1Down
Replies
4
Views
356
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,984
Messages
6,122,601
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top