Solved

VBA Loop error (Creating NCCA BRACKET)

Posted on 2011-03-13
7
367 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
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel Calculation 4 48
Web Query 1 19
Highlight changing numbers in column 3 16
Conditional formatting excel 5 13
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

809 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