PDA

View Full Version : Weird runtime errors



LethPhaos
09-12-2007, 01:40 AM
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
09-12-2007, 02:03 AM
It's not an infinite loop, it just feels like it! You could define a range like this:
Set rngCheck = Intersect(Worksheets("organisations").Columns("A"), Worksheets("organisations").UsedRange)
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.