Need help with nested loop in VB

N

NPUser

Registered User.
Local time
Today, 18:23
Joined
Jul 25, 2004
Messages
55
I have code below to analyze existing network username to potential new user's usernames. If no match then user gets first initial and lastname if there is a match (conflict) then the user gets first two character from their firstname and lastname.

Following code works except right after the insert statement i want to rst.requery to get the newly created username in in the rst recordset but it won't work. I have attached the database Access 2000, when you click on the form command, it will create same username for two people.

Please help



Private Sub Command0_Click()
Dim strSql As String
Dim StrSql1 As String

Dim strSqlUpdate As String
Dim rst As DAO.Recordset
Dim rsn As DAO.Recordset

strSql = "SELECT SamAccountName as UserName from Network UNION Select UserName From temp_user; "

strsql2 = "SELECT id_num, last_name, first_name, middle_name FROM Admission;"

Set rsn = CurrentDb.OpenRecordset(strsql2)


rsn.MoveFirst
Do While Not rsn.EOF

Dim lngStep As Integer
lngStep = 1


Set rst = CurrentDb.OpenRecordset(strSql)
rst.MoveFirst
Dim TempUserName As String
Do While Not rst.EOF


TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name

If rst!UserName = RTrim(TempUserName) Then
lngStep = lngStep + 1
rst.MoveFirst
Else
rst.MoveNext
End If

Loop

strSqlUpdate = "INSERT into temp_user (id_num, last_name, First_name, Middle_name, UserName) VALUES ( " & rsn!ID_num & ", '" & rsn!Last_Name & " ', '" & rsn!First_name & "', '" & rsn!Middle_Name & "' , ' " & TempUserName & "');"
CurrentDb.Execute strSqlUpdate

rsn.MoveNext
Loop

Set rst = Nothing
Set rsn = Nothing
DoCmd.OpenTable "temp_user"
End Sub
Click to expand...
 

Attachments

Last edited:
You have an extra space in your code, meaning you are looking up one value ("JDoe") but writing another value (" JDoe").

Change this line:

Code: 
strSqlUpdate = "INSERT into temp_user (id_num, last_name, First_name, Middle_name, UserName) VALUES ( " & rsn!ID_num & ", '" & rsn!Last_Name & " ', '" & rsn!First_name & "', '" & rsn!Middle_Name & "' , ' " & TempUserName & "');"

To this:

Code: 
strSqlUpdate = "INSERT into temp_user (id_num, last_name, First_name, Middle_name, UserName) VALUES ( " & rsn!ID_num & ", '" & rsn!Last_Name & " ', '" & rsn!First_name & "', '" & rsn!Middle_Name & "' , '" & TempUserName & "');"

Also, not sure if you care, but DLookup is easier:

Code: 
Private Sub Command0_Click()

    Dim StrSql2 As String
    Dim strSqlUpdate As String
    Dim rsn As DAO.Recordset
    Dim TempUserName As String
    Dim lngStep As Integer
    
    StrSql2 = "SELECT id_num, last_name, first_name, middle_name FROM Admission;"
    
    Set rsn = CurrentDb.OpenRecordset(StrSql2)
    
    rsn.MoveFirst
    
    Do While Not rsn.EOF

        lngStep = 1
        
        'Propose the first username
        TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name
        
        'Check to see if the user name exists
        Do While Not IsNull(DLookup("UserName", "qryUserName", "UserName = '" & TempUserName & "'"))
            
            'If so, try the next one
            lngStep = lngStep + 1
            TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name
         
        Loop
          
        strSqlUpdate = "INSERT  into temp_user (id_num, last_name, First_name, Middle_name, UserName) VALUES ( " & rsn!ID_num & ", '" & rsn!Last_Name & " ', '" & rsn!First_name & "', '" & rsn!Middle_Name & "' , '" & TempUserName & "');"
        CurrentDb.Execute strSqlUpdate
        
    rsn.MoveNext

    Loop


Set rsn = Nothing
DoCmd.OpenTable "temp_user"
End Sub

One more point - you will run into a problem if you have two users where you can't find a unique user name. You might want to code for that...
 
ejstefl - thank you very much. I went over that INSERT Statement almost 10 times and seems like i just overlooked it everytime. Ohh - i was ready to pull my hair out and believe me i do not have much left to pull.

One more point - you will run into a problem if you have two users where you can't find a unique user name. You might want to code for that...
Click to expand...

If you don't mind could you clearify that for me. Would not this line create new user name and re-validate it against the rst.
Do While Not rst.EOF
TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name
If rst!UserName = RTrim(TempUserName) Then
lngStep = lngStep + 1
'move to first line and start the check again to see if new proposed username already exist

rst.MoveFirst
Else
'all good move to next users
rst.MoveNext
End If

Loop
Click to expand...
Do i have that wrong ?
 
Glad to help!

What I'm saying is that if you come across a scenario where you have two user names that cannot be made unique with this method, your loop will run forever. For example, if you have a user names in the database of JDoe, JaDoe, and JanDoe (maybe because you have two Janes and a January) and you are trying to add a user named Jan Doe. It will try JDoe, JaDoe, JanDoe, none of which will work, and then it will loop to infinity. You might want to limit the number of loops to the lenght of the first name, and then maybe try adding numbers or something. Just a thought, don't know how realistic the scenario is, or how many users you are adding.
 
That makes sense. I will put not to exceed limit on first name left characters to 4.

I am adding about 350 users per semester. So far i experienced about 10 duplicate usernames per batch and no more than two people with same names.

Sorry to be a pest. But i have one more question.

I am trying to add middle_name into the mix. If it is duplicate username then try to insert their middle initial into username if they have middle name.

I came up with this but it goes into infinite loop.

rsn.MoveFirst
While Not rsn.EOF

Dim lngStep As Integer
lngStep = 1


Set rst = CurrentDb.OpenRecordset(strSql)
rst.MoveFirst
Dim TempUserName As String
While Not rst.EOF


TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name

' check dup usernames
If rst!UserName = RTrim(TempUserName) Then
'Dup username check to see if middle name exists

If IsNull(rsn!middle_name) Then 'no middle name
lngStep = lngStep + 1

Else
'has middle name - grab first initial from middle_name
're-check
TempUserName = Left(rsn!First_name, 1) + Left(rsn!middle_name, 1) + rsn!Last_Name
End If
rst.MoveFirst
Else
rst.MoveNext
End If

Wend

strSqlUpdate = "INSERT into temp_user (id_num, last_name, First_name, Middle_name, UserName) VALUES ( " & rsn!ID_num & ", '" & rsn!Last_Name & " ', '" & rsn!First_name & "', '" & rsn!middle_name & "' , '" & TempUserName & "');"
CurrentDb.Execute strSqlUpdate

rsn.MoveNext
Wend
Set rst = Nothing
Set rsn = Nothing
Click to expand...
 
Last edited:
This is what i came up with for middle name. It looks to be working.

thanks


Private Sub Command0_Click()
Dim StrSql2 As String
Dim strSqlUpdate As String
Dim rsn As DAO.Recordset
Dim TempUserName As String
Dim lngStep As Integer

StrSql2 = "SELECT id_num, last_name, first_name, middle_name FROM Admission;"

Set rsn = CurrentDb.OpenRecordset(StrSql2)

rsn.MoveFirst

Do While Not rsn.EOF

lngStep = 1
Dim mnCheck As Boolean
mnCheck = False
'Propose the first username
TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name

'Check to see if the user name exists
Do While Not IsNull(DLookup("UserName", "qryUserName", "UserName = '" & TempUserName & "'"))

'If so, try the next one

If Not IsNull(rsn!middle_name) And mnCheck = False Then
TempUserName = Left(rsn!First_name, 1) + Left(rsn!middle_name, 1) + rsn!Last_Name
mnCheck = True
Else
lngStep = lngStep + 1
TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name
End If
Loop

strSqlUpdate = "INSERT into temp_user (id_num, last_name, First_name, Middle_name, UserName) VALUES ( " & rsn!ID_num & ", '" & rsn!Last_Name & " ', '" & rsn!First_name & "', '" & rsn!middle_name & "' , '" & TempUserName & "');"
CurrentDb.Execute strSqlUpdate

rsn.MoveNext

Loop


Set rsn = Nothing

DoCmd.OpenTable "temp_user"
End Sub
Click to expand...
 
It looks like the problem is that if the user has a middle name, and the user name with the middle name exists, you'll be stuck in infinite loop. What you need to do is only try the middle name once.

The logic should go something like this:

Try First Initial + Last. If exists,

If Middle name exists, Try First Initial + Middle Initial + Last. If exists,

Try First 2 Initials + Last name. If exists, loop until you find one that works.

Write user name.
 
ejstefl,
Thanks for looking into this. Per your suggestion -this is what i came up with.

It appears to be working.

sa


Do While Not rsn.EOF
......
.........
......
lngStep = 1
Dim mnCheck As Boolean
mnCheck = False
'Propose the first username
TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name

'Check to see if the user name exists
Do While Not IsNull(DLookup("UserName", "qryUserName", "UserName = '" & TempUserName & "'"))

'If so, try the next one

If Not IsNull(rsn!middle_name) And mnCheck = False Then
TempUserName = Left(rsn!First_name, 1) + Left(rsn!middle_name, 1) + rsn!Last_Name
mnCheck = True
Else
lngStep = lngStep + 1
TempUserName = Left(rsn!First_name, lngStep) + rsn!Last_Name
End If
Loop
..............
...........
Click to expand...
 
Looks like you found a great solution! Glad to have helped.
 
You must log in or register to reply here.

Similar threads

zelarra821
Solved Loop through records in a table that gives an error
Replies
4
Views
337
zelarra821
zelarra821
A
Solved Loop recordset and print reports
Replies
5
Views
735
Pat Hartman
P
D
Solved Nested Loop
Replies
4
Views
700
Drand
D
A
Solved checkbox placed in frame by a query, not responding
Replies
2
Views
577
Pat Hartman
P
G
Need help with Replace module and wildcards
Replies
5
Views
618
ebs17
E

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom