Nested VBA loops coming out of early

I have a vba script that needs to copy data from one sheet to another. It does this with three nested loops. Executing the code while debugging seems to work fine, but when the vba script runs, they seem to stop too early. Otherwise the vba script works.

I stared at it for hours and couldn't let life see me, which would make the loops stop earlier. I hope the solution is something simple that I missed, but I have a real loss, not the first time since I started this.

The sheet is organized as follows:

Sheet1 contains the data to be copied.

  • Each line contains a separate answer, of which 55 are in the test data
  • The sheet contains nine blocks of data, named Episode 1-9. Each episode contains a column where an integer represents the start, end, and time interval.
  • In the test data, each episode is identical except for the start / end time.
  • The maximum value for EndTime is 36
  • Testing is done only on the first four Episode blocks, so Episode4 contains EndTime = 36 for each line

Sheet2 where the data should go -The first column contains each RespondentID copied over 36 lines -The whole second column contains numbers 1-36, thus representing the time interval for this respondent -11 Columns then contain the area into which the data copied from sheet1 for this respondent / time. These 36x11 areas are named "Response1-55" in the test data

The logic of the vba script is as follows:

Counters: - n counter for the number of respondents - r counter for the number of episodes - I counter for the lines within the copied responses.

-> For each answer (from n = 1 to respondents)
-> Select the first episode (From r = 1 to 9)
   ---> For each episode
   ---> Read the beginning, end and time interval
   ---> From i = Start to i = End copy the corresponding cells from the nth row of the r'th episode
   ---> Copy those cells to the i-th row of the current response in sheet2
   ---> When you reach the EndTime of the current episode, go to next (next r)
-> If the episode you just finished has 36 as the ending time, skip to the next answer or continue until you finish the episodes.
→ Next answer

In debugging, the code looks like this.

However, when I run the vba script on the test sheet, it only works for episodes 1 and 2. The data from episodes 3 and 4 is not copied. Nothing is copied in its place, and the data that is copied is correct in all respects. In any case, there are no error messages.

If anyone can guess why this might have happened, I would build a real church for them. The answer can also be added here: https://stackoverflow.com/a/1890383/ , which doesn't have a section for VBA yet.

The link to the test sheet is here: http://dl.dropbox.com/u/41041934/MrExcelExample/TornHairExampleSheet.xlsm

The relevant part of the code is here

Sub PopulateMedia()
    Application.ScreenUpdating = False

    'Count the total number of response rows in original sheet
    Dim Responses As Long, n As Integer, i As Integer, r As Integer
        Responses = (Sheets("Sheet1").UsedRange.Rows.Count - 3) ' equals 55 in test sheet

    'For each response...
    For n = 1 To Responses
        i = 1 'Reset i for new response
            Dim curr_resp As Range
                Set curr_resp = Sheets(2).Range("Response" & n) 'Define a range containing all response data

            For r = 1 To 9  'For each episode...
                Dim curr_ep As Range 'Define a range containing episode data for all responses
                    Set curr_ep = Sheets(1).Range("episode" & r)

                Dim Stime As Integer, Etime As Integer, Itime As Integer 'Variables contain start, end and inter-episode times
                    Stime = curr_ep.Cells(n, 1)
                    Etime = curr_ep.Cells(n, 17)
                    Itime = curr_ep.Cells(n, 19)

                    For i = Stime To (Etime + Itime) 'for each time-slot...
                        If i <= Etime Then
                          Dim a As Variant
                            a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
                            curr_resp.Rows(i) = a 'Copy data from above current episode to current response for slots between Stime and Etime
                        End If
                    Next i
                If Etime = 36 Then Exit For
             Next r
     Next n

    Application.ScreenUpdating = True
End Sub

      

To disclose, I already got help on this project from this site, a copy of the VBA from combining two ranges into a row of another range , but the code has changed a little since then and that's a different problem.

Thanks again so much for any help that may arise from this. I've looked at this for hours and can't see where the error is. Any guidance whatsoever was greatly appreciated.

+3


source to share


1 answer


I would post this as a comment if I could, but it's too long. So here it is as a request / potential solution

I think your range references are the problem

The code below is a shorthand version of your code

curr_ep

is the named range of episode1. It has a range address$Y$4:$AQ$58



When you loop a

, you set the range using this syntax,
a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))


which is equivalent to a = curr_ep.Range("Y2:AQ2")

which means you are really looking at not what I think you may have planned, i.e. you are plotting unintentional bias AW2:BG2

Y2:AQ2

Sub PopulateMedia()
    n = 1
    r = 1
    Dim curr_ep As Range
    Dim curr_test As Range
    Set curr_ep = Sheets(1).Range("episode" & r)
    Set curr_test = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
End Sub

      

enter image description here

+5


source







All Articles