Code not looping correctly

[Aussie_Striker]

Frustrated here as I had this code working then after adding a few extras found that it was not looping correctly. After trying to fix it I could still not find where the problem is. It is only running through the loop one time. I think the problem is the following code in bold near the bottom but I cannot work out how it should go.

ActiveCell.Offset(20, 0).Select
End If
Next
End With
Else
End If
NTDS = MsgBox(

Sub Generate_TDS()


'Generate team sheets based on Teams listed on reference sheet
CDchk = MsgBox("Do you wish to clear data first?", vbYesNo, "Clear Data?")
If CDchk = 6 Then
Application.ScreenUpdating = False
Application.Run "Clear_for_season"
Else
End If
GTDS = MsgBox("Are you sure you wish to generate the Team Data Sheets? ", vbYesNo, "Generate Team Data Sheets")
If GTDS = 6 Then

'MsgBox "Updating References from Team Nominations", , "References"
Application.Run "ListFiles"
Application.Run "Update_Reference_Sheet"
Application.ScreenUpdating = True
Sheets("References").Select
Application.ScreenUpdating = False
Dim i As Integer

With Sheets("References")
    For i = 6 To 46
    Dim nm
    nm = Worksheets("References").Cells(i, 2)
        If Cells(i, 2) <> "" Then
            Sheets("TDS Template").Copy before:=Worksheets("End") 'Copies the template sheet to before sheet 'End'
            Sheets("TDS Template (2)").Range("am6").Value = (nm) 'Pastes team name
            Sheets("TDS Template (2)").Name = (nm) ' Puts team name on template
    
    
    'Place team player data on All Players, Best and Fairest and Ring-Ins sheet
    Sheets("All Players TP").Select
    Range("A6:n25").Select
    Selection.Copy
    Sheets("All Players").Select
    Range("A6").Select
    Do Until ActiveCell = ""
     If ActiveCell <> "" Then
     ActiveCell.Offset(20, 0).Select
     Else
    End If
    Loop
    ActiveSheet.Paste
    Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
   ActiveCell.Offset(20, 0).Select 'to increment 20 places
        
    Sheets("All Players TP").Select
    Range("t6:Az25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Best and Fairest").Select
    Range("A6").Select
    Do Until ActiveCell = ""
     If ActiveCell <> "" Then
     ActiveCell.Offset(20, 0).Select
     Else
    End If
    Loop
    ActiveSheet.Paste
    Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveCell.Offset(20, 0).Select
    
    Sheets("All Players TP").Select
    Range("bb6:db25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ring In Players").Select
    Range("A6").Select
    Do Until ActiveCell = ""
        If ActiveCell <> "" Then
        ActiveCell.Offset(20, 0).Select
         Else
        End If
    Loop
    ActiveSheet.Paste
    Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveCell.Offset(20, 0).Select
    End If
    Next
End With
   Else
   End If
   NTDS = MsgBox("Do you wish to update data from the nominations to the Team Data Sheets?", vbYesNo, "Nomination Data Updata")
         If NTDS = 6 Then
  Application.Run "input_teams" 'Macro to put team nominations onto Team Data sheets
    Else
    End If
          
          
    Sheets("Co-ord Menu").Select


End Sub

[Leith Ross]

Hello Aussie_Striker,

The most obvious problems I see in the code are the DIM statements need to be moved to the top of the Sub before any other code. Eventhough FOR ... NEXT loops will work without the index following NEXT statement, this is a bad programming practice, If you make these 3 changes, it will most likely fix your problem.

Sincerely,
Leith Ross

[Aussie_Striker]

Hello Aussie_Striker,

The most obvious problems I see in the code are the DIM statements need to be moved to the top of the Sub before any other code. Eventhough FOR ... NEXT loops will work without the index following NEXT statement, this is a bad programming practice, If you make these 3 changes, it will most likely fix your problem.

Don't quite understand what that means. Do you mean it doesn't need the next but should have it? With the dim, possibly it should not be a dim? the nm being the name of the worksheet will change on each loop. Will that affect it if I move the dim to the top of the code?

[MSP77079]

Hi Aussie,

You only DIM a variable one time (unless it is an array and you are resizing it; in which case, you still only DIM it once, and thereafter you use REDIM).

You can put a DIM statement anywhere in the code, as long as you put it before you actually use the variable (otherwise, it is dimensioned by VB at the point it is first used when the code is complied and you get a duplicate dimension error). By convention, people tend to put all of the DIM statements at the top of the code. I have never put a DIM statement inside a loop. I sort of agree with Leith that this could cause a problem. But, I just tested it in a little routine and ... surprised me ... it did not cause a problem.

Move it outside the loop anyway. What the heck ... put it at the top of the code. But, after doing the test mentioned above, I do not believe this is causing the problem.

As for the "next" statement. VB has no problem with a loop like this:

    For n = 1 To 10
        'whatever
    Next

But, you and I might. The issue is that as soon as you start having loops within loops and a bunch of if statements interspersed, it becomes impossible to figure out which "For" goes with which "Next" ... for us humans. So, we tend to write the code like this:

    For n = 1 To 10
        'whatever
    Next n

We find it easier to read that way.

Anyway, you are asking for help and all we have given you so far is gratuitous advice. Let me try to dig a bit deeper and see if I can figure out your problem.

But ... to Leith's point ... the lack of consistent indenting, combined with the lack of tell using which For goes with which Next, and the occassional oddly-placed Dim statement, all add up to making this code very difficult to read! Which means we might not be able to provide help as easily as we would like to.

[MSP77079]

Not at all sure, but my guess is that this line of code is the problem:

If Cells(i, 2) <> "" Then

If my guess is correct, then you have 2 options for fiixing it.
1. put a dot (.) in from of Cells

If .Cells(i, 2) <> "" Then

so that VB knows it is referring to

With Sheets("References")

otherwise, the WITH statement is not doing anything for you that I can see.

2. you did a very good job of referencing in this statement:

nm = Worksheets("References").Cells(i, 2)

so, you could replace the line I think is causing you problems with

If n <> "" Then

Let me know if that does not solve you problem and I'll look some more. Meanwhile a couple of other tips that might help make coding easier.

When you have a MsgBox with vbYesNo, you can check the response like this (for example) … Instead of

If GTDS = 6 Then

Use

If GTDS = vbYes Then

You DO NOT need an Else statement with every IF … END IF. If you are not going to put anything between ELSE and END IF, then skip the ELSE.

[Aussie_Striker]

Thanks, I'll get onto those and see if it fixes it. I went through and indented the code how it should be. The majority of the code was working. I added the first and last messagebox to run extra bits and I think it was after that the main part failed. I was getting error with end if not being where it should. My biggest mistake was not having a backup save where that code was working and I had saved past that point. I'll see if what you have suggested above works. Thanks

Sub Generate_TDS()

Dim nm
Dim i As Integer

' Clear Data if required
        CDchk = MsgBox("Do you wish to clear data first?", vbYesNo, "Clear Data?")
        If CDchk = 6 Then
        Application.ScreenUpdating = False
        Application.Run "Clear_for_season"
        Else
        End If
        
'Generate team sheets based on Teams listed on reference sheet
GTDS = MsgBox("Are you sure you wish to generate the Team Data Sheets? ", vbYesNo, "Generate Team Data Sheets")
If GTDS = 6 Then

        Application.Run "ListFiles"
        Application.Run "Update_Reference_Sheet"
        Application.ScreenUpdating = True
        Sheets("References").Select
        Application.ScreenUpdating = False

        With Sheets("References")
        For i = 6 To 46
        nm = Worksheets("References").Cells(i, 2)
        If Cells(i, 2) <> "" Then
            Sheets("TDS Template").Copy before:=Worksheets("End") 'Copies the template sheet to before sheet 'End'
            Sheets("TDS Template (2)").Range("am6").Value = (nm) 'Pastes team name
            Sheets("TDS Template (2)").Name = (nm) ' Puts team name on template
    
'Place team player data on All Players, Best and Fairest and Ring-Ins sheet

    'All Players
            Sheets("All Players TP").Select
            Range("A6:v25").Select
            Selection.Copy
            Sheets("All Players").Select
            Range("A6").Select
            
                Do Until ActiveCell = ""
                If ActiveCell <> "" Then
                ActiveCell.Offset(20, 0).Select
                Else
                End If
                Loop
            
            ActiveSheet.Paste
            Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        
            ActiveCell.Offset(20, 0).Select 'to increment 20 places
            
    'Best and Fairest
            Sheets("All Players TP").Select
            Range("x6:bd25").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Best and Fairest").Select
            Range("A6").Select
            
                Do Until ActiveCell = ""
                If ActiveCell <> "" Then
                ActiveCell.Offset(20, 0).Select
                Else
                End If
                Loop
                
            ActiveSheet.Paste
            Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            ActiveCell.Offset(20, 0).Select
            
    ' Ring in players
            Sheets("All Players TP").Select
            Range("bf6:df25").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Ring In Players").Select
            Range("A6").Select
            
                Do Until ActiveCell = ""
                If ActiveCell <> "" Then
                ActiveCell.Offset(20, 0).Select
                Else
                End If
                Loop
                
            ActiveSheet.Paste
            Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            ActiveCell.Offset(20, 0).Select
        
        End If
        Next
        End With
Else
End If
        NTDS = MsgBox("Do you wish to update data from the nominations to the Team Data Sheets?", vbYesNo, "Nomination Data Updata")
        If NTDS = 6 Then
        Application.Run "input_teams" 'Macro to put team nominations onto Team Data sheets
        Else
        End If
                  
    Sheets("Co-ord Menu").Select

End Sub