INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Logic problem Excel VBA returning Access Data

Logic problem Excel VBA returning Access Data

(OP)
Hi all:
I'm having a slight logic problem that I cannot figure out. What the client wants is to find out if the email address is active or not, and since the DB may (and does) contain more than one status for opting out, I'm forced to return the values width-wise instead of like a table. The procedure works great for the first name only.

CODE

Sub CreateMailList()

    Dim Cat As ADOX.Catalog
    Dim Con As ADODB.Connection
    Dim RS As ADODB.Recordset
    Dim numRecords As Long
    Dim i As Long
    Dim SQL As String
    Dim Q As String
        
        Set Cat = New ADOX.Catalog
        Set Con = New ADODB.Connection
        Set RS = New ADODB.Recordset

        Q = Chr(34)

   
    Sheets("Mail Chimp").Select
    Range("A1").Select
    
Do

    ActiveCell.Offset(1, 0).Activate
    If ActiveCell.Value = "" Then Exit Sub
    s = ActiveCell.Text
    i = 3
    Con.Provider = "Microsoft.ACE.OLEDB.12.0" '"Microsoft.Jet.OLEDB.4.0"
    Con.Open "Data Source=C:\Users\Repp-Web\Downloads\Agents2Email.accdb"
   
   
   SQL = "SELECT qRealtors2OffAddZipEmail.RStat" & _
        " FROM qRealtors2OffAddZipEmail " & _
        "GROUP BY qRealtors2OffAddZipEmail.RStat, qRealtors2OffAddZipEmail.Email1 " & _
        "HAVING (((qRealtors2OffAddZipEmail.Email1)=" & Q & s & Q & "));"
      
      'Debug.Print SQL
      
   RS.Open SQL, Con, adOpenDynamic, adLockOptimistic, adCmdText
   
   Do While Not RS.EOF
            s = RS(0).Value
         
'here is the problem (I think)
   
            If ActiveCell.Offset(0, i).Value = "" Then
                ActiveCell.Offset(0, i).Value = s
                i = i + 1
            Else
                i = i + 1
                ActiveCell.Offset(0, i).Value = s
            End If
            
   
        RS.MoveNext
   Loop
            

    On Error Resume Next
            RS.Close
            Set RS = Nothing
            Con.Close
            Set Con = Nothing
Loop

End Sub 

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors http://www.repproductions.net

RE: Logic problem Excel VBA returning Access Data

In the loop:

CODE -->

If ActiveCell.Offset(0, i).Value = "" Then
    ActiveCell.Offset(0, i).Value = s
    i = i + 1
Else
    i = i + 1
    ActiveCell.Offset(0, i).Value = s
End If 
you check the cell i rows below active cell, if is empty assign s, else assign s to next row, without checking contents. Whatever you did, i becomes i+1. Is it what you plan to do? Have you checked RS contents?

combo

RE: Logic problem Excel VBA returning Access Data

(OP)
Hi Skip:

Thanks for the thought. I don't use the Watch Window a lot, but I was using the Immediate Window with Debug.Print on the variables to see them change. I removed them before I posted the code.

I did take your advice, though, but still prefer the Immediate Window. You've helped me too many times over the years not to at least try something innocuous.

Thanks,

Ron

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors http://www.repproductions.net

RE: Logic problem Excel VBA returning Access Data

(OP)
Combo:

Thanks for your reply.

Yes, that is what I planned to do, because I need the data to show on the spreadsheet like a crosstab report. I'm given a spreadsheet with the email addresses (all in Column A) and the client wants all the opt-out statuses in line with the email address.

I did find one problem in logic, but still not the answer. The code gives me the correct # of records, but keeps returning the first value. Here is how I changed the code. I also added the variable T to make sure those weren't getting confused (even in my head)

CODE

'Con.Open & Con.Provider removed from here
Do

    ActiveCell.Offset(1, 0).Activate
    If ActiveCell.Value = "" Then Exit Sub
    S = ActiveCell.Text 'this is an email address
    i = 3 'I start with 3 because the client has already placed some of his statuses in Column D, but they do not adhere to the database
    
Con.Open & Con.Provider moved to here
    Set Con = New ADODB.Connection
    Set RS = New ADODB.Recordset
    
    Con.Provider = "Microsoft.ACE.OLEDB.12.0" '"Microsoft.Jet.OLEDB.4.0"
    Con.Open "Data Source=C:\Users\Repp-Web\Downloads\Agents2Email.accdb"
   
   
  SQL = "SELECT qRealtors2OffAddZipEmail.RStat" & _
        " FROM qRealtors2OffAddZipEmail " & _
        "GROUP BY qRealtors2OffAddZipEmail.RStat, qRealtors2OffAddZipEmail.Email1 " ' & _
        '"HAVING (((qRealtors2OffAddZipEmail.Email1)=" & Q & S & Q & "));"
      
      'Debug.Print SQL
      
    'SQL = "SELECT qRealtors2OffAddZipEmail.RStat" & _
        " FROM qRealtors2OffAddZipEmail " & _
        "WHERE (((qRealtors2OffAddZipEmail.Email1)=" & Q & S & Q & "));"
      
   RS.Open SQL, Con, adOpenDynamic, adLockOptimistic, adCmdText
   
   Do While Not RS.EOF
            T = RS(0).Value
            
            
            If ActiveCell.Offset(0, i).Value = "" Then
                ActiveCell.Offset(0, i).Value = T
                i = i + 1
            Else
                i = i + 1
                ActiveCell.Offset(0, i).Value = T
            End If
            
   
        RS.MoveNext
   Loop
            

    'On Error Resume Next
            RS.Close
            Set RS = Nothing
            Con.Close
            Set Con = Nothing
Loop 

Thanks,

Ron

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors http://www.repproductions.net

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close