VBA Find and Vlookup code help!

[Danny_Kemp]

Hi all,

I have wrote some code that allows me to search my excel database and return all the employees that report to a pre-defined manager, and puts the values in a list.

I would like to add some further criteria to my search and I am struggling to write the code correctly.

Here is the code:

Sub Find()
Dim Manager
Dim RowCount
Dim Employee
Manager = Sheets("Production Master 20.4.15").Range("E14")
RowCount = Sheets("Kronos").Range("AA" & Rows.Count).End(xlUp).Row
With Worksheets("Kronos").Range("AA4:AA" & RowCount & "")
Set c = .Find(Manager, LookIn:=xlValues, SearchOrder:=xlByRows)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Sheets("Kronos").Activate
c.Offset(0, -8).Select
Selection.Copy
Sheets("Production Master 20.4.15").Select
Employee = Sheets("Production Master 20.4.15").Range("E" & Rows.Count).End(xlUp).Row + 1
Range("E" & Employee & "").PasteSpecial Paste:=xlPasteValues
Sheets("Kronos").Select
Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
End Sub

What I want to add is something like this:

If Not c Is Nothing AND c.Offset(0, 5) = "28M" And c.Offset(0, 6) = "MOULD" Then

The idea is I then have 3 search criteria's: Manager, if the cell 5 to the right is 28M and 6 to the right is MOULD. If all of these are correct then return the value in the cell 8 to the left.

Does anyone whole how to add these additional criteria into my code?

 

[baitmaster]

you're struggling probably because the additional tests requires c to exist, so they can't go on the same line as the test of whether c does exist

Try this, noting that I've changed your code in a few other places too:

Option Explicit

Sub Find()

Dim firstAddress As String
Dim Employee As Long
With Worksheets("Kronos").Range("AA")
    
    On Error Resume Next
        Set c = .Find(Range("Manager").Value, LookIn:=xlValues, SearchOrder:=xlByRows)
    On Error GoTo 0
    
    If Not c Is Nothing Then
        
        firstAddress = c.Address
        Do
            
            If c.Offset(0, 5) = "28M" And c.Offset(0, 6) = "MOULD" Then
                With Sheets("Production Master 20.4.15")
                    Employee = .Range("E" & Rows.Count).End(xlUp).Row + 1
                    .Range("E" & Employee & "").Value = c.Offset(0, -8).Value
                End With
            End If
            
            Set c = .FindNext(c)
        
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    
End With
End Sub

- I've created a named range called "manager" - this will make your code more robust, it will still work if that cell moves.
- There's an error handler around your first attempt to create c, in case it can't find it
- I'm happy to search the entire of column AA without restricting rows, FIND is a very fast feature, and this simplifies your code slightly
- I've removed all activation, selection etc., which slows your code by jumping around and generally looking untidy. We don't need to move the cursor onto an object in order to work with it via VBA

HTH

 

[baitmaster]

forgot to declare c as well...
Dim c as range

 

[Danny_Kemp]

Thanks for your reply.

This really helped to get me the result I wanted.

FYI the code I now have is:

Sub TestFind()
Dim Manager
Dim firstAddress As String
Dim Employee As Long
Dim c As Range
Manager = Sheets("Production Master 20.4.15").Range("E14")
With Worksheets("Kronos").Columns("AA")

On Error Resume Next
Set c = .Find(Manager, LookIn:=xlValues, SearchOrder:=xlByRows)
On Error GoTo 0

If Not c Is Nothing Then

firstAddress = c.Address
Do

If c.Offset(0, 5) = "28M" And c.Offset(0, 6) = "MOULD" Then
With Sheets("Production Master 20.4.15")
Employee = .Range("E" & Rows.Count).End(xlUp).Row + 1
.Range("E" & Employee & "").Value = c.Offset(0, -8).Value
End With
End If

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address <> firstAddress
End If

End With
End Sub



Any suggestions to tidying it up further?

 

[baitmaster]

There's only a couple of things I'd do, aimed at making it more robust

- create the named range called manager [formulas > name manager] to define this, then use this as shown in my code example

- work out the VBA name for the worksheet that is called "Production Master 20.4.15" in Excel. In the VBA Project Explorer window you'll see e.g. SheetX(Production Master 20.4.15). You can replace [Sheets("Production Master 20.4.15")] in your code with [SheetX] and it won't matter if the worksheet gets renamed

I never quite worked out why you are finding/using employee like you are. I might use a different approach but if yours works then why change it?

No need to tidy further, thats not an excessive length of code. More important is commenting and indentation so you can read it easily again later