VBA Find and Vlookup code help!

Danny_Kemp

New Member
Joined
Jun 19, 2015
Messages
30
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?
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

baitmaster

Well-known Member
Joined
Mar 12, 2009
Messages
2,039
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:
Code:
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
 

Danny_Kemp

New Member
Joined
Jun 19, 2015
Messages
30
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

Well-known Member
Joined
Mar 12, 2009
Messages
2,039
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,087
Messages
5,599,658
Members
414,325
Latest member
kfg1287

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top