VBA Find Does Not Work But Manual FindAll Works

[shanep]

Hi

I'm having trouble using VBA's Find function.

I have a worksheet which holds a concatenation of AppID's and App Names in Column U. There are approximately 12,000 rows and each cell in Column U holds one of either of the following value formats:

242 - Application 1
242 - Application 1; 1845 - Application 2
242 - Application 1, 1845 - Application 2; 34678 - Application 3
etc...

I need to find all instances of a chosen App ID and then copy any row in which the App ID appears to a new sheet (to obtain the chosen AppID I am presenting a list of those to the user in a form Listbox, and I know the selection ofthe AppID is functioning as I am currently presenting it in a MsgBox prior to running this part of the code).

When I run a manual FindAll on a given AppID it returns all the cells in Column U which that AppID appears, but when I use the following code to achieve the same it does not seem to find the AppID's.

(NB - I've "borrowed" this code from a posting on Ozgrid, but I have also compared it to the many other FindAll methods available on the web and they all apppear to be pretty similar).

(The changing of the cells interior colour is just a way of identifying whether it's working prior to writing the code to copy the row ino a new sheet).

Dim temp2WS as Worksheet
Set temp2WS = ThisWorkBook.Worksheets("AppID")
Dim lCount As Long
Dim rFoundCell As Range
Set rFoundCell = temp2WS.Range("U1")
temp2WS.Activate
rFoundCell.Select
For lCount = 1 To iTemp
     Set rFoundCell = Columns("U:U").Find(What:=vID, After:=rFoundCell, LookIn _
     :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
     :=xlNext, MatchCase:=False, SearchFormat:=False)
           With rFoundCell
                .Interior.ColorIndex = RGB(255, 55, 55)
           End With
Next lCount

I've been trying to get this to work for over a day now and it's driving me mad so any help is reatly appreciated.

Thanks
Shane

 

[VoG]

Hello and welcome to MrExcel.

As far as I can see vID isn't assigned a value before the .Find is executed:

Set rFoundCell = Columns("U:U").Find(What:=vID, After:=rFoundCell, LookIn _
     :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
     :=xlNext, MatchCase:=False, SearchFormat:=False)

If you are looking for the string "vID" then

Set rFoundCell = Columns("U:U").Find(What:="vID", After:=rFoundCell, LookIn _
     :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
     :=xlNext, MatchCase:=False, SearchFormat:=False)

 

[shanep]

Hi VoG, and thanks for the quick response.

I've posted the full code for you so you can vID is being set earlier on in the process.

I amended the .Find to search for "vID" instead of vID but I still get an error. The RTE is "13" (Type Mismatch) and the
code below is what the VBE highlights as the problem.

Set rFoundCell = temp2WS.Columns("U:U").Find(What:="vID", After:=rFoundCell, LookIn _
            :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
            :=xlNext, MatchCase:=False, SearchFormat:=False)

Any other thoughts no you can see the full picture?

Thanks
Shane

Private Sub CommandButton3_Click()
Dim appWS As Worksheet
Set appWS = ThisWorkbook.Worksheets("AppID")
Dim iAppIDCount As Integer
iAppIDCount = appWS.Range("A36556").End(xlUp).Row
Dim rAppID As Range
Set rAppID = appWS.Range("A" & iAppIDCount)
Dim x As Long
x = rAppID.Value
Dim i As Long, msg As String, Check As String
Dim vID As Variant
Dim sID As String
Dim dDate As Date
Dim dTime As Date
Dim sDate As String
Dim sTime As String
     'Generate a list of the selected items
    With comboAppID
        'For i = 0 To .ListCount - 1
        For i = 0 To x
            If .Selected(i) Then
                vID = comboAppID.List(i)
                msg = msg & vID & vbNewLine
            End If
        Next i
    End With
 
    If msg = vbNullString Then
         'If nothing was selected, tell user and let them try again
        MsgBox "Nothing was selected!  Please make a selection!"
        Exit Sub
    Else
         'Ask the user if they are happy with their selection(s)
        Check = MsgBox("You selected:" & vbNewLine & "Application ID " & msg & vbNewLine & _
        "Are you happy with your selection?", _
        vbYesNo + vbInformation, "Please confirm")
    End If
 
    If Check = vbYes Then
 
        Unload frmAppID
 
        ' define destination worksheet (in this workbook)
        Dim tempWS As Worksheet
        Set tempWS = Sheets.Add
 
        ' name the new worksheet
        dTime = FormatDateTime(Now, vbLongTime)
        sTime = Format(dTime, "HHMMSS")
        dDate = FormatDateTime(Now, vbLongDate)
        sDate = Format(dDate, "YYYYMMDD")
        sID = "AppID" & vID & "(" & sDate & sTime & ")"
        tempWS.Name = sID
        ' define and set path variable
        Dim drivePath As String
        drivePath = "I:\CITI\Application Data\"
        ' find outif "Server - Detail" worksheet already exists
        Dim sh As Worksheet, flg As Boolean
        For Each sh In Worksheets
            If sh.Name Like "Server - Detail" Then flg = True: Exit For
        Next
 
        ' if it does move on, else create it
        If flg = True Then
        Else
            Dim sourceWB As Workbook
            Set sourceWB = Workbooks.Open(drivePath & "Source Files\eTools.xls")
            Dim sourceWS As Worksheet
            Set sourceWS = sourceWB.Worksheets("Server - Detail")
            Dim temp1WS As Worksheet
            Set temp1WS = ThisWorkbook.Sheets.Add
            temp1WS.Name = "Server - Detail"
        End If
 
        Dim temp2WS As Worksheet
        Set temp2WS = ThisWorkbook.Worksheets("Server - Detail")
        Dim iTemp As Integer
        iTemp = temp2WS.Range("B36556").End(xlUp).Row
 
        Dim lCount As Long
        Dim rFoundCell As Range
 
        For lCount = 1 To iTemp
            Set rFoundCell = temp2WS.Columns("U:U").Find(What:="vID", After:=rFoundCell, LookIn _
            :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
            :=xlNext, MatchCase:=False, SearchFormat:=False)
            MsgBox rFoundCell.Address
        Next lCount
 
    Else
         'User wants to select a new appID so clear listbox selections and
         'return user to the userform
        For i = 0 To comboAppID.ListCount - 1
            comboAppID.Selected(i) = False
        Next
    End If
End Sub

 

[VoG]

OK then, as vID is a variable you need to remove the quotes. I suggest that you include a check of what is being searched for like this:

            MsgBox vID
            Set rFoundCell = temp2WS.Columns("U:U").Find(What:=vID, After:=rFoundCell, LookIn _
            :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
            :=xlNext, MatchCase:=False, SearchFormat:=False)
            MsgBox rFoundCell.Address

 

[shanep]

the MsgBox displays "242" (without the quotes) which is as expected. but it still generates the same RTE 13....

 

[VoG]

I think that the problem is here

            Set rFoundCell = temp2WS.Columns("U:U").Find(What:=vID, After:=rFoundCell, LookIn _
            :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
            :=xlNext, MatchCase:=False, SearchFormat:=False)
            MsgBox rFoundCell.Address

On the first execution of the loop rFoundCell is Nothing so the code fails. Perhaps before the loop add

Set rFoundCell = Range("U1")

 

[shanep]

thanks!!!, that seems to have cured that problem.

however, whilst it runs correctly the code now takes 2 minutes to complete because the loop is executing 11891 times (i.e. the value of iTemp - which is the number of rows in the "Server - Detail" worksheet).

I've put the following code in to try to get it to loop only the same number of times as there are occurences of the vID variable in column U but it doesn't even get into the loop as the worksheet.countif function is reurning 0.

any ideas whay that would be the case when there are around 20 occurences of "242" in column U?

For lCount = 1 To WorksheetFunction.CountIf(Columns("U:U"), vID)
            Set rFoundCell = temp2WS.Columns("U:U").Find(What:=vID, After:=rFoundCell, LookIn _
            :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
            :=xlNext, MatchCase:=False, SearchFormat:=False)
            With rFoundCell
                .Interior.Color = RGB(255, 45, 67)
            End With
        Next lCount

 

[VoG]

I'm not sure but instead of looping in the way that you are perhaps you could use the FindNext method. I'm not going to try to rewrite your code to do this but here's an example that I prepared earlier:

Sub FindHighlight()
Dim tempcell As Range, Found As Range, sTxt, FoundRange As Range, Response As Integer
Set Found = Range("A1")
sTxt = InputBox(prompt:="Enter value for search", Title:="VoG's Finder")
If sTxt = "" Then Exit Sub
Set tempcell = Cells.Find(What:=sTxt, After:=Found)
If tempcell Is Nothing Then
    MsgBox prompt:="Not found", Title:="VoG's Finder"
    Exit Sub
Else
    Set Found = tempcell
    Set FoundRange = Found
End If
Do
    Set tempcell = Cells.FindNext(After:=Found)
    If Found.Row >= tempcell.Row Then Exit Do
    Set Found = tempcell
    Set FoundRange = Application.Union(FoundRange, Found)
Loop
FoundRange.Interior.ColorIndex = 6
Response = MsgBox(prompt:="Clear highlighting", Title:="VoG's Finder", Buttons:=vbOKCancel + vbQuestion)
If Response = vbOK Then FoundRange.Interior.ColorIndex = xlNone
End Sub

 

[shanep]

VoG

With the help of this post

http://www.eggheadcafe.com/conversation.aspx?messageid=32639572&threadid=32639561

I was able to identify that the worksheetfunction.countif was not picking up on the value of vID because column U did not solely contain appID's but also other text strings.

when I created a second vID with 'wildcards' appended to each end of vID, i.e.

vID2 = "*" & vID & "*"

and used that in the worksheetfunction.countif it picked them all up.

many thanks for all your help, really appreciated!

full code below for anyone else who gets stuck on this.

Private Sub CommandButton3_Click()
Dim appWS As Worksheet
Set appWS = ThisWorkbook.Worksheets("AppID")
Dim iAppIDCount As Integer
iAppIDCount = appWS.Range("A36556").End(xlUp).Row
Dim rAppID As Range
Set rAppID = appWS.Range("A" & iAppIDCount)
Dim x As Long
x = rAppID.Value
Dim i As Long, msg As String, Check As String
Dim vID As Variant
Dim sID As String
Dim dDate As Date
Dim dTime As Date
Dim sDate As String
Dim sTime As String
     'Generate a list of the selected items
    With comboAppID
        'For i = 0 To .ListCount - 1
        For i = 0 To x
            If .Selected(i) Then
                vID = comboAppID.List(i)
                msg = msg & vID & vbNewLine
            End If
        Next i
    End With
 
    If msg = vbNullString Then
         'If nothing was selected, tell user and let them try again
        MsgBox "Nothing was selected!  Please make a selection!"
        Exit Sub
    Else
         'Ask the user if they are happy with their selection(s)
        Check = MsgBox("You selected:" & vbNewLine & "Application ID " & msg & vbNewLine & _
        "Are you happy with your selection?", _
        vbYesNo + vbInformation, "Please confirm")
    End If
 
    If Check = vbYes Then
 
        Unload frmAppID
 
        ' define destination worksheet (in this workbook)
        Dim tempWS As Worksheet
        Set tempWS = Sheets.Add
 
        ' name the new worksheet
        dTime = FormatDateTime(Now, vbLongTime)
        sTime = Format(dTime, "HHMMSS")
        dDate = FormatDateTime(Now, vbLongDate)
        sDate = Format(dDate, "YYYYMMDD")
        sID = "AppID" & vID & "(" & sDate & sTime & ")"
        tempWS.Name = sID
        ' define and set path variable
        Dim drivePath As String
        drivePath = "I:\CITI\Application Data\"
        ' find outif "Server - Detail" worksheet already exists
        Dim sh As Worksheet, flg As Boolean
        For Each sh In Worksheets
            If sh.Name Like "Server - Detail" Then flg = True: Exit For
        Next
 
        ' if it does move on, else create it
        If flg = True Then
        Else
            Dim sourceWB As Workbook
            Set sourceWB = Workbooks.Open(drivePath & "Source Files\eTools.xls")
            Dim sourceWS As Worksheet
            Set sourceWS = sourceWB.Worksheets("Server - Detail")
            Dim temp1WS As Worksheet
            Set temp1WS = ThisWorkbook.Sheets.Add
            temp1WS.Name = "Server - Detail"
        End If
 
        Dim temp2WS As Worksheet
        Set temp2WS = ThisWorkbook.Worksheets("Server - Detail")
        Dim iTemp As Integer
        iTemp = temp2WS.Range("B36556").End(xlUp).Row
 
        Dim lCount As Long
        Dim rFoundCell As Range
        Set rFoundCell = Range("U1")
        temp2WS.Activate
 
        vID1 = "*" & vID & "*"
        d = WorksheetFunction.countIf(Columns("U:U"), vID1)
        MsgBox d
        'rFoundCell.Select
        For lCount = 1 To WorksheetFunction.countIf(Columns("U:U"), vID1) 'iTemp
            'MsgBox vID
            Set rFoundCell = temp2WS.Columns("U:U").Find(What:=vID, After:=rFoundCell, LookIn _
            :=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection _
            :=xlNext, MatchCase:=False, SearchFormat:=False)
            'MsgBox rFoundCell.Address
            With rFoundCell
                .Interior.Color = RGB(120, 45, 67)
            End With
 
        Next lCount
 
    Else
         'User wants to select a new appID so clear listbox selections and
         'return user to the userform
        For i = 0 To comboAppID.ListCount - 1
            comboAppID.Selected(i) = False
        Next
    End If
End Sub

 

[VoG]

Thanks for the feedback, Shane.

Peter