Solved

VBA Loop error (Creating NCCA BRACKET)

Posted on 2011-03-13
7
369 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Independent Software Vendors: 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

Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

Question has a verified solution.

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

Suggested Solutions

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…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

739 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