Endless Loop?

**teaker** · 06-15-2009, 01:06 PM

Hi again... Having another problem with the same macro that has been giving me trouble for a week now. Now, the macro will run, but after it finishes, excel stops responding. Is this because the macro continues to run indefinitely? Any ideas?

Sub ParseInputToWorksheets()

    Dim memberLists As Workbook
    Dim chapterColumn As String
    Set memberLists = ActiveWorkbook
    chapterColumn = "B"
    
    Dim newMembers As Workbook
    Dim newMembersFilePath As String
    newMembersFilePath = "C:\Creeds\Database\SAE\NewList.xlsx"
    Set newMembers = GetObject(newMembersFilePath)
    
    Dim r As Range
    For Each r In newMembers.Worksheets(1).Rows
        Dim chapterName As String
        chapterName = r.Cells(1, chapterColumn)
        Call CopyToChapter(chapterName, r)
    Next
    
End Sub

Private Sub CopyToChapter(chapterName As String, r As Range)
    Dim memberLists As Workbook
    Dim ws As Worksheet
    Set memberLists = ActiveWorkbook
    For Each ws In memberLists.Worksheets
        If ws.Name = chapterName Then
            Dim iRow As Long
                iRow = FirstEmptyRowIndex(ws)
                r.Copy (ws.Rows(iRow))
            Exit Sub
        End If
    Next
End Sub



Private Function FirstEmptyRowIndex(ws As Worksheet) As Long
    Dim firstCell As Range
    Set firstCell = ws.Range("A1")
    Dim iRow As Long
    iRow = 0
    Do
        iRow = iRow + 1
        If firstCell.Offset(iRow, 0).Value = "" Then Exit Do
    Loop
    FirstEmptyRowIndex = iRow + 1
End Function

**Greg M** · 06-15-2009, 04:50 PM

Hi there,

I haven't checked all of your code, but this suggestion might be a good place to start!

Regarding

Is this because the macro continues to run indefinitely?

the macro isn't running "indefinitely", but because of

For Each r In newMembers.Worksheets(1).Rows

it's happily processing all 65536 rows in the worksheet!

Try the following code which will limit the macro's "attention" to the rows between Row 2 and the row which contains the last data record:

Sub ParseInputToWorksheets()

    Dim memberLists As Workbook
    Dim chapterColumn As String
    Set memberLists = ActiveWorkbook
    chapterColumn = "B"

    Dim newMembers As Workbook
    Dim newMembersFilePath As String
    newMembersFilePath = "C:\Creeds\Database\SAE\NewList.xlsx"
    Set newMembers = GetObject(newMembersFilePath)

    Dim memberRows As Long
    memberRows = newMembers.Worksheets(1).UsedRange.Rows.Count

    Dim r As Range
        For Each r In newMembers.Worksheets(1).Range(newMembers.Worksheets(1).Rows(2), _
                                                     newMembers.Worksheets(1).Rows(memberRows))

        Dim chapterName As String
        chapterName = r.Cells(1, chapterColumn)
        Call CopyToChapter(chapterName, r)
    Next

End Sub

I hope this helps - please let me know how you get on or if you need anything further.

Regards,

Greg M

**teaker** · 06-16-2009, 10:00 AM

Ah, worked like a charm!

Thanks!!

**Greg M** · 06-16-2009, 10:39 AM

Hi again,

Many thanks for your feedback - I'm glad I was able to help.

Regards,

Greg M

Endless Loop?

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Endless Loop?

Re: Endless Loop?

Re: Endless Loop?

Re: Endless Loop?

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions