Solved

VBA Loop error (Creating NCCA BRACKET)

Posted on 2011-03-13
7
370 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 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

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

734 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