0

VB6 - "FindFirst" with multiple search Criteria
Hi everyone,
I am trying to modify and expedite the execution of this VB module that was started by an someone else.
If you look at the underlying module, you'll see that there are numerous nested loops(Loops within a loop). I understand that he used this approach because he couldn't adequately code the FindFirst function.
Looking at the module below, what is the most efficient way for me to imbed the "FindFirst" function, because that will be more efficient than all these loops.

Below is the module:

ii = 5
    ii = ii + 1

    Do Until M.qBW.EOF
        xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
        xlWksht.Cells(ii, 2).Value = M.qBW![Description]
        xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
        xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

        rsinPers.MoveFirst
        Do Until rsinPers.EOF
           If rsinPers![Name] = M.qBW![Personnel2] Then
           xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
           rsinPers.MoveNext
        Loop

        rsinPers.MoveFirst
        Do Until rsinPers.EOF
           If rsinPers![Name] = M.qBW![Personnel3] Then xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
           rsinPers.MoveNext
        Loop
        
          rsinPers.MoveFirst
        Do Until rsinPers.EOF
           If rsinPers![Name] = M.qBW![Personnel4] Then xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
           rsinPers.MoveNext
        Loop
        
        rsinPers.MoveFirst
        Do Until rsinPers.EOF
           If rsinPers![Name] = M.qBW![Personnel5] Then xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
           rsinPers.MoveNext
        Loop
        
        rsinPers.MoveFirst
        Do Until rsinPers.EOF
           If rsinPers![Name] = M.qBW![Personnel6] Then xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hr]
           rsinPers.MoveNext
        Loop
        
        xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
        xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
        xlWksht.Cells(ii, 12).Value = M.qBW![EstimatedStartDate] & Chr(10) & M.qBW![Start Date]
        xlWksht.Cells(ii, 13).Value = M.qBW![EstimatedEndDate] & Chr(10) & M.qBW![End  Date]
        xlWksht.Cells(ii, 14).Value = "Comments:" & Chr(10) & "'" & M.qBW![Comments]
    Loop

Thanks,
tgifgemini.

2
Contributors
6
Replies
10
Views
9 Years
Discussion Span
Last Post by tgifgemini
1

Hi,

It shud be some thing like this:

rsinPers.MoveFirst
Do
   rsinPers.Find "Name='" & M.qBW![Personnel2] & "'"
  If  rsinPers.EOF
       Exit Do
  Else
       xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
   End If
 Loop

Regards
Veena

0

Good morning Veena.
I've see your code, but before I implement it, I want you to take a look at the way I used the FindFirst logic/Function and tell me what you think.

M.qBW.MoveFirst
    rsinPers.MoveFirst

    Do Until M.qBW.EOF = True
        xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
        xlWksht.Cells(ii, 2).Value = M.qBW![Description]
        xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
        xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

        SrchCriteria = "[Name]= '" & rsinPers![Personnel2] & "'"
        M.qBW.FindFirst SrchCriteria
        If M.qBW.NoMatch = False Then
           xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
        End If

        SrchCriteria = "[Name]= '" & rsinPers![Personnel3] & "'"
        M.qBW.FindFirst SrchCriteria
        If M.qBW.NoMatch = False Then
           xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
        End If

        SrchCriteria = "[Name]= '" & rsinPers![Personnel4] & "'"
        M.qBW.FindFirst SrchCriteria
        If M.qBW.NoMatch = False Then
           xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
        End If

        SrchCriteria = "[Name]= '" & rsinPers![Personnel5] & "'"
        M.qBW.FindFirst SrchCriteria
        If M.qBW.NoMatch = False Then
           xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
        End If

        SrchCriteria = "[Name]= '" & rsinPers![Personnel6] & "'"
        M.qBW.FindFirst SrchCriteria
        If M.qBW.NoMatch = False Then
           xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
        End If

        xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
        xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
        xlWksht.Cells(ii, 12).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
        xlWksht.Cells(ii, 13).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date]
        xlWksht.Cells(ii, 14).Value = "Comments:" & Chr(10) & "'" & M.qBW![Comments]

        rsinPers.MoveNext
        M.qBW.MoveNext
    Loop

Thanks.
tgifgemini.

Edited by mike_2000_17: Fixed formatting

0

Please disregard the previous post. I forgot to use code tags:[///]

Good morning Veena.
I've see your code, but before I implement it, I want you to take a look at the way I used the FindFirst logic/Function and tell me what you think.

M.qBW.MoveFirst
rsinPers.MoveFirst

Do Until M.qBW.EOF = True
xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
xlWksht.Cells(ii, 2).Value = M.qBW![Description]
xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

SrchCriteria = "[Name]= '" & rsinPers![Personnel2] & "'"
M.qBW.FindFirst SrchCriteria
If M.qBW.NoMatch = False Then
xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
End If

SrchCriteria = "[Name]= '" & rsinPers![Personnel3] & "'"
M.qBW.FindFirst SrchCriteria
If M.qBW.NoMatch = False Then
xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
End If

SrchCriteria = "[Name]= '" & rsinPers![Personnel4] & "'"
M.qBW.FindFirst SrchCriteria
If M.qBW.NoMatch = False Then
xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
End If

SrchCriteria = "[Name]= '" & rsinPers![Personnel5] & "'"
M.qBW.FindFirst SrchCriteria
If M.qBW.NoMatch = False Then
xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
End If

SrchCriteria = "[Name]= '" & rsinPers![Personnel6] & "'"
M.qBW.FindFirst SrchCriteria
If M.qBW.NoMatch = False Then
xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
End If

xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
xlWksht.Cells(ii, 12).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
xlWksht.Cells(ii, 13).Value = M.qBW![End Date] & Chr(10) & M.qBW![End Date]
xlWksht.Cells(ii, 14).Value = "Comments:" & Chr(10) & "'" & M.qBW![Comments]

rsinPers.MoveNext
M.qBW.MoveNext
Loop

Thanks.
tgifgemini.

0

Hi,

yes ur code is correct, i thought u had multiple results for search crieteria, so i put in a loop, but if it is only one, then u can go ahead, it seems al right to me..

regards
Veena

0

Hi,

I noticed, u r using Find First, there is no "FindFirst" for ADO, if using DAO then alright.
My code was for ADO.

Regards
Veena

0

Good morning Veena.
Yes, I am using DAO and it has "FindFirst" object.
Thanks.
tgifgemini.

This question has already been answered. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.