Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VBA Loop error (Creating NCCA BRACKET)

Posted on 2011-03-13
7
Medium Priority
?
375 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
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 2000 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

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

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

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
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…

721 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