My VBA Macro Sometimes Works and Sometimes Doesn't

**chsaav** · 02-22-2013, 08:16 AM

Hello Guys.
First of all I apologize for my English.
I believe a little background is needed: I have a hush workbook with an inspection template; one of the functionalities is that the user can search employees’ names to assign actions and send notifications emails. I have a worksheet filled with all employees data from GAL and basically I’m interested in two columns: (B) with emails and (D) with names. I have to state that I know very little about VBA but with a lot of help from this forum I came up with a code that search for the employee’s name and place it in a userform listbox for user selection. I recently found out that I have duplicates on names column and that causes me a problem when a subsequent macro has to find the email address associated with this name. After some frustrating attempts to populate a two columns listbox I tried a way around by populating a range in a sheet with the data retrieved by the LOCATE macro but it works sometimes and most of the times don’t. It is a weird thing. I need some help please. Here is the first LOCATE macro and the one I being tried.


Sub Locate(name As String, data As Range)

    Dim rngFind As Range
    Dim strFirstFind As String
    
    With data
        Set rngFind = .Find(name, LookIn:=xlValues, lookat:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            Do
                If rngFind.Row > 1 Then
                ListBox1.AddItem rngFind.Value
                End If
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    Set rngFind = Nothing
End Sub


Sub Locate(name As String, data As Range)

    Dim rngFind As Range
    Dim strFirstFind As String
    
    With data
        Set rngFind = .Find(name, LookIn:=xlValues, lookat:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            Do
                If rngFind.Row > 1 Then
                ThisWorkbook.Sheets("sheet1").Range("AK1").End(xlDown).Offset(1, 0).Value = rngFind.Value

                End If
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    Set rngFind = Nothing
End Sub

The Variable "name" come from a textbox used by user to input string to search.

Sorry. I forgot the error when macro does not work (most of the time) is:
run-time error:'1004'
application-difined or object-difined error

**AlphaFrog** · 02-22-2013, 08:40 AM

If column AK is empty or just has a header in AK1 and no data below, this line will error.
ThisWorkbook.Sheets("sheet1").Range("AK1").End(xlDown).Offset(1, 0).Value = rngFind.Value

Try this instead...
ThisWorkbook.Sheets("sheet1").Range("AK" & Rows.Count).End(xlUp).Offset(1).Value = rngFind.Value

**chsaav** · 02-22-2013, 09:38 AM

AlphaFrog.
That works perfectly; it populates the column with all recurrences matching the string I’m looking for and the error is gone no matter how many times a run the code.
I have another question; I don’t know if I am breaking the forum’s rules by asking in this same post but here it is:
I just write a code to place the email address associated with the employee’s name in the cell next to the right of all the names found by Locate macro (the one you just fixed) so, after this I can populate the same listbox but this time with two columns so the user may choose the right employee as he (the user) can also see the email address of which there are no duplicates. This is the macro (it is located in a standard module):

Sub Locate817()
Set emailaddress = ThisWorkbook.Sheets("outlook").Range("d2:d20000").Find(ThisWorkbook.Sheets("Sheet1").Range("AK" & Rows.Count).End(xlUp).Value)
If Not emailaddress Is Nothing Then ThisWorkbook.Sheets("Sheet1").Range("AL" & Rows.Count).End(xlUp).Offset(1).Value = emailaddress.Offset(0, -2).Value
Set emailaddress = Nothing
End Sub

It does work fine but, when I place it in the loop it stops the looping.
If I place it after this line (ThisWorkbook.Sheets("sheet1").Range("AK" & Rows.Count).End(xlUp).Offset(1).Value = rngFind.Value), it doesn’t loop. And I tried to place it after this line (Set rngFind = .FindNext(rngFind)) it only loops twice and I know there are more recurrences. It looks like for some reason the macro sets the rngFind.Address value equal to strFirstFind value.
Is there a way to make this thing works?
Again thank you very much and I apologize for these dumbs questions.

**chsaav** · 02-22-2013, 11:21 AM

I found a way around. i know it is not the most efficeint way but is working. Here is the code, it is called from the locate macro at the end of the loop.

Sub Locate818()
Dim emailaddress As Range
Dim i As Integer
For i = 1 To 500
If ThisWorkbook.Sheets("Sheet1").Cells(i, "AK").Value <> "" Then
Application.ScreenUpdating = False
Set emailaddress = ThisWorkbook.Sheets("outlook").Range("d2:d20000").Find(ThisWorkbook.Sheets("Sheet1").Cells(i, "AK"))
If Not emailaddress Is Nothing Then ThisWorkbook.Sheets("Sheet1").Range("AL" & Rows.Count).End(xlUp).Offset(1).Value = emailaddress.Offset(0, -2).Value
End If
Next i
Set emailaddress = Nothing
Application.ScreenUpdating = True
End Sub

If you have a more elegant way (I'm sure you have) please let me know...Best regards.

**AlphaFrog** · 02-22-2013, 09:10 PM

Originally Posted by chsaav

I just write a code to place the email address associated with the employee’s name in the cell next to the right of all the names found by Locate macro (the one you just fixed) so, after this I can populate the same listbox but this time with two columns so the user may choose the right employee as he (the user) can also see the email address of which there are no duplicates. This is the macro (it is located in a standard module):

I'm not sure I follow but couldn't you just offset fron the found name to get its' email?

Sub Locate(name As String, data As Range)
    
    Dim rngFind As Range
    Dim strFirstFind As String
    
    With data
        Set rngFind = .Find(name, LookIn:=xlValues, lookat:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            Do
                If rngFind.Row > 1 Then
                    With Sheets("sheet1").Range("AK" & Rows.Count).End(xlUp).Offset(1)
                        .Value = rngFind.Value                          'Name in column AK
                        .Offset(, 1).Value = rngFind.Offset(, -2).vlaue 'email in column AL
                    End With
                End If
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    Set rngFind = Nothing
End Sub