Solved: Simplify this listbox code

[ndendrinos]

This is by Lucas (may he forgive me) but I need to shorten the code if at all possible and tailor it to my needs.

I've started but I'm at a loss as to how to finish it.
What I need is this :

The ListBox Value would look in column A of sheet "Vault" for a match of the invoice number chosen in the listbox, then if found would copy the whole row , return to sheet "Search Inv" and past same to the first row (Row1) starting in cell A1

This afternoon I posted the same question at MrExcel but without a sample of the workbook I think my message will stay unanswered.

http://www.mrexcel.com/forum/newreply.php?do=newreply&noquote=1&p=2059052

[ndendrinos]

got rid of the listbox and now use a sheet change event. Still I think the code can be simplified ... example: what is "employee" and how come if I replace each instance of the word "employee" to "invoice" in the code it stops working?

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Employee As Variant
Dim Name As String
Dim firstaddress As String

Employee = Empty
'If you add more than 500 names you will need to increase this

'I've increased it to A:A is this OK?


With Sheets("Vault").Range("A:A")
If Not Intersect(Target, Range("D5")) Is Nothing Then
Name = [D5].Value
Set Employee = .Find(what:=Name, LookIn:=xlValues)
If Not Employee Is Nothing Then Employee.Rows.EntireRow.Copy Else Exit Sub

[A1].Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'bypasses the "to empty" clipboard msg
Application.CutCopyMode = False
End If
End With
End Sub

[lucas]

You can eliminate the selection:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Employee As Variant
Dim Name As String
Dim firstaddress As String

Employee = Empty
'If you add more than 500 names you will need to increase this

'I've increased it to A:A is this OK?


With Sheets("Vault").Range("A:A")
If Not Intersect(Target, Range("D5")) Is Nothing Then
Name = [D5].Value
Set Employee = .Find(what:=Name, LookIn:=xlValues)
If Not Employee Is Nothing Then Employee.Rows.EntireRow.Copy Else Exit Sub

'you can get rid of the selection on the call to pastespecial
'old
' [A1].Activate
' Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
' False, Transpose:=False

'new
[A1].PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


'bypasses the "to empty" clipboard msg
Application.CutCopyMode = False
End If
End With
End Sub

[ndendrinos]

Thank you lucas for the revision.
Been busy here and have come up with this code that I understand better with my limited knowledge of VBA.
It appears to work well EXCEPT when I try to run it from a sheet change event (I tried with "If Not Intersect(Target, Range("D5")) Is Nothing Then...)
but that did not work ... lots of flickering and no result.


Sub test()
Application.ScreenUpdating = False
lookfor = [D5].Value
Sheets("Vault").Activate
Cells.Find(What:=lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Rows.EntireRow.Copy

Sheets("Search Inv").Activate
[A1].PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[ndendrinos]

Cheated and got it to work from a sheet change event like this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5")) Is Nothing Then
Call test
End If
End Sub

There should be another way I'm sure

[ndendrinos]

OK so I was hasty in declaring victory and figured out that the "Find" should
be limited to Column A and not the way it is written (looks all over the sheet I guess)


Cells.Find(What:=lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Rows.EntireRow.Copy

Please assist ... wife number 1 reckons I spend too much time on the computer.

[ndendrinos]

As long as the "Find" happens to reside in column A I'm doing much better when replacing :

Cells.Find(What:=lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Rows.EntireRow.Copy
with

Cells.Find(What:=lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Rows.EntireRow.Copy

Is there no code to restrict the "Find" in ONE column only? (column A or column.1) and if not found then msgbox "invoice not found"

[mdmackillop]

Dim c As Range
Set c = Columns(1).Find(What:=lookfor, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not c Is Nothing Then
c.EntireRow.Copy
Else
MsgBox lookfor & " not found"
End If

[ndendrinos]

Thank you mdmackillop.

Revised the code to :

Sub test()
Application.ScreenUpdating = False
lookfor = [D5].Value
Sheets("Vault").Activate
Dim c As Range
Set c = Columns(1).Find(What:=lookfor, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not c Is Nothing Then
c.EntireRow.Copy
Else
MsgBox lookfor & " not found"
End If

Sheets("Search Inv").Activate
[A1].Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

and got an error when looking for a value that did not exist (after the msgbox showed) Run time error 1004/Paste special method of Range Class failed with this "yellowed"
The
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


Moved things around and added an extra ... Sheets("Search Inv").Activate
and it works well now

Sub test()
Application.ScreenUpdating = False
lookfor = [D5].Value
Sheets("Vault").Activate
Dim c As Range
Set c = Columns(1).Find(What:=lookfor, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not c Is Nothing Then
c.EntireRow.Copy

Sheets("Search Inv").Activate
[A1].Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Application.CutCopyMode = False

Else
MsgBox lookfor & " not found"
End If
Sheets("Search Inv").Activate

Application.ScreenUpdating = True
End Sub

I will mark this solved this afternoon just in case I get more feedback

[mdmackillop]

Try to avoid activating sheets to speed up your code
Sub test()
Dim c As Range
lookfor = Sheets("Search Inv").Range("D5").Value

With Sheets("Vault")
Set c = .Columns(1).Find(What:=lookfor, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not c Is Nothing Then
c.EntireRow.Copy
Sheets("Search Inv").Range("A1").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Else
MsgBox lookfor & " not found"
End If
End With
End Sub

[ndendrinos]

Good advice always well taken.Thanks again.
Ahem... had to add a short "end with" but other than this minor omission everything works well.
I can put this one to rest now.