Weird runtime errors

[LethPhaos]

Hi there,

I'm having a weird problem with some loops I'm writing. When I uncomment the 2 loops in the main loop I get an infinite loop, because it also goes through all empty cells in the range. The problem is that I get runtime errors when commenting out the 2 subloops, or when I use more than 2 Ranges like ("A1:A5") instead of ("A:A").

This is the code:

Option Explicit
Option Compare Text
Private c As Integer
Public Sub GenerateEmails()
    Dim c1, c2, c3 As Variant   'vars for looping
    Dim org As String           'the organisation that's being processed
    Dim orgs As String          'list of all organisations that have been processed
    Dim locs As Integer         'the number of locations
    Dim body As String          'the body of the email that's being generated
    Dim adds As String          'the emailaddresses the email needs to be sent to
    Dim temp As String          'for temporary storage
 
    c = 0 'for debugging, first 10 results will be shown
 
    'loop through organisations
    For Each c1 In Worksheets("organisations").Range("A:A").Cells
        If InStr(orgs, c1.Text) = False Then
            org = c1.Text
            orgs = orgs & ";" & org
            adds = ""
 
            '********** start message **********
            body = Worksheets("mail_parts").Range("B1").Text
 
            '********** insert company name **********
            '<Company name>
            '<Company Alias 1>
            '<Company Alias 2>
            '<Company Alias ?>
            body = body & org & vbCrLf
            body = body & "<ADD COMPANY ALIASES MANUALLY>" & vbCrLf & vbCrLf
 
            '********** loop through locations of current organisation **********
            'For Each c3 In Worksheets("organisations").Range("A:A").Cells
            '    If LCase(c3.Text) = LCase(org) Then
            '
            '        locs = locs + 1
            '
            '        '? Location <Number>
            '        If UCase(c3.Offset(0, 4).Text) = "Y" Then temp = " (Primary location)"
            '        body = body & "? Location " & locs & temp & vbCrLf
            '        temp = ""
            '        '   <Address>
            '        body = body & vbTab & c3.Offset(0, 5).Text & " " & c3.Offset(0, 6).Text & vbCrLf '(street & number)1 & (street & number)2
            '        body = body & vbTab & c3.Offset(0, 8).Text & " " & c3.Offset(0, 3).Text & vbCrLf 'postcode & city
            '        body = body & vbTab & c3.Offset(0, 5).Text & vbCrLf 'country
            '        '   <General phone number>
            '        body = body & vbTab & "Phone: " & c3.Offset(0, 10).Text & vbCrLf
            '        '   <General fax number>
            '        body = body & vbTab & "Fax: " & c3.Offset(0, 11).Text & vbCrLf & vbCrLf
            '
            '    End If
            'Next c3
 
            '********** loop through contacts of current organisation **********
            'For Each c2 In Worksheets("contacts").Range("A:A").Cells
            '    If LCase(c2.Text) = LCase(org) Then
            '
            '        body = body & "? Contacts:" & vbCrLf & vbCrLf
            '
            '        '<Contact name>
            '        body = body & vbTab & c2.Offset(0, 1).Text & " " & c2.Offset(0, 2).Text & " " & c2.Offset(0, 3).Text & vbCrLf
            '        '<Phone>
            '        body = body & vbTab & c2.Offset(0, 4).Text & vbCrLf
            '        '<Cellphone>
            '        body = body & vbTab & c2.Offset(0, 5).Text & vbCrLf
            '        '<Email>
            '        body = body & vbTab & c2.Offset(0, 6).Text & vbCrLf
            '        adds = adds & ";" & c2.Offset(0, 6).Text
            '        '<Portal ID>
            '        body = body & vbTab & c2.Offset(0, 9).Text & vbCrLf & vbCrLf
            '
            '    End If
            'Next c2
 
            '********** finish message **********
            body = body & Worksheets("mail_parts").Range("B3").Text
 
            c = c + 1
            If c <= 10 Then
                Worksheets("test").Range("A" & c).Text = body
                Worksheets("test").Range("B" & c).Text = adds
            End If
 
        End If
    Next c1
End Sub

Thanks for any help!!!

[rory]

It's not an infinite loop, it just feels like it! You could define a range like this:
[VBA]Set rngCheck = Intersect(Worksheets("organisations").Columns("A"), Worksheets("organisations").UsedRange)[/VBA]
to only look at the populated cells but I suspect it would be quicker to use an autofilter on each sheet and loop through the visible cells instead. Or do this in a database.