Solved

VBA Loop error (Creating NCCA BRACKET)

Posted on 2011-03-13
7
368 Views
Last Modified: 2012-05-11
I got this great code through Experts Exchange and it works good except I have ran into a problem.  My friend and I are trying to build a NCAA bracket.   We use data validation to create lists as you move forward to each round of the bracket.  For example after you have selected teams for the round of 32 then only those teams can be selected for Sweet 16 and so on.   In an early question to experts exchange was how we could write code so that if someone selected a team in round of 32, then sweet 16, and say elite 8, but decided that actually that team would lose in the Sweet 16 then it clears that team out of future rounds since it is not longer an option and avoid mistakes.   This code works great on the left hand side of the bracket but it clears out the field of 64 on the right side of the bracket and freezes up.  Not sure how to change this to make it work.  I have uploaded the code as well as the worksheet to look at.  I am hoping to get this figured out today if anyone has time to help out.  
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, i As Long, strTeam As String

If Not Intersect(Target, Range("D6:N38")) Is Nothing Then
    Application.EnableEvents = False
        For i = Target.Column + 1 To 9
            strTeam = Target.Offset(, i - Target.Column).MergeArea.Cells(1, 1)
            
            For Each cl In Target.Offset(, i - Target.Column).MergeArea.Cells
                If cl.Offset(, -1) = strTeam Then GoTo noIssueLeft
            Next
            
            Target.Offset(, i - Target.Column).MergeArea.ClearContents

noIssueLeft:
        Next i
        
        For i = Target.Column + 1 To 9 Step -1
            strTeam = Target.Offset(, i - Target.Column).MergeArea.Cells(1, 1)
            
            For Each cl In Target.Offset(, i - Target.Column).MergeArea.Cells
                If cl.Offset(, 1) = strTeam Then GoTo noIssueLeft
            Next
        
            Target.Offset(, i - Target.Column).MergeArea.ClearContents
noIssueRight:
        Next i
        
    Application.EnableEvents = True
End If

End Sub

Open in new window

Test-Sheet-3-12-11-C.xlsm
0
Comment
Question by:Apex623
  • 4
  • 3
7 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 35129707
Hi, here is the code you need:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, i As Long, strTeam As String

If Not Intersect(Target, Range("D6:N38")) Is Nothing Then
    Application.EnableEvents = False
        For i = Target.Column + 1 To 9
            strTeam = Target.Offset(, i - Target.Column).MergeArea.Cells(1, 1)
            
            For Each cl In Target.Offset(, i - Target.Column).MergeArea.Cells
                If cl.Offset(, -1) = strTeam Then GoTo noIssueLeft
            Next
            
            Target.Offset(, i - Target.Column).MergeArea.ClearContents

noIssueLeft:
        Next i
        
        For i = Target.Column - 1 To 9 Step -1
            'get current selected winner
            strTeam = Target.Offset(, -(Target.Column - i)).MergeArea.Cells(1, 1)
            
            For Each cl In Target.Offset(, -(Target.Column - i)).MergeArea.Cells
                If cl.Offset(, 1) = strTeam Then GoTo noIssueRight
            Next
        
            Target.Offset(, -(Target.Column - i)).MergeArea.ClearContents
noIssueRight:
        Next i
        
    Application.EnableEvents = True
End If

End Sub

Open in new window


Please use the "Ask a related question" button when you post a related question, it generates a warning to the experts who've helped you on the previous question and often reduces your leadtime.

Thomas
0
 
LVL 1

Author Comment

by:Apex623
ID: 35129844
Thanks for the help and I did not know about the related question I will be sure to use that in the future.  I will give this a shot.
0
 
LVL 1

Author Comment

by:Apex623
ID: 35130536
One final thing that I need help with.  If you want to start over and you select all cells or all cells with in a bracket and delete you get an error.  Any way to fix this?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 39

Accepted Solution

by:
nutsch earned 500 total points
ID: 35130605
Update to address mass changes

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, i As Long, strTeam As String, clTarget As Range

If Not Intersect(Target, Range("D6:N38")) Is Nothing Then
    Application.EnableEvents = False
    
    For Each clTarget In Target.Cells
        
        For i = clTarget.Column + 1 To 9
            strTeam = clTarget.Offset(, i - clTarget.Column).MergeArea.Cells(1, 1)
            
            For Each cl In clTarget.Offset(, i - clTarget.Column).MergeArea.Cells
                If cl.Offset(, -1) = strTeam Then GoTo noIssueLeft
            Next
            
            clTarget.Offset(, i - clTarget.Column).MergeArea.ClearContents

noIssueLeft:
        Next i
        
        For i = clTarget.Column - 1 To 9 Step -1
            'get current selected winner
            strTeam = clTarget.Offset(, -(clTarget.Column - i)).MergeArea.Cells(1, 1)
            
            For Each cl In clTarget.Offset(, -(clTarget.Column - i)).MergeArea.Cells
                If cl.Offset(, 1) = strTeam Then GoTo noIssueRight
            Next
        
            clTarget.Offset(, -(clTarget.Column - i)).MergeArea.ClearContents
noIssueRight:
        Next i
        
    Next clTarget
        
    Application.EnableEvents = True
End If

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:Apex623
ID: 35132395
Okay this seems to be working great.   Again I thank you for all of your help on this it will be a great addition to our bracket this year.  
0
 
LVL 1

Author Closing Comment

by:Apex623
ID: 35132402
Great job and very prompt with helping me with fixes.
0
 
LVL 39

Expert Comment

by:nutsch
ID: 35132927
GLad to help.

Thomas
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

685 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question