PDA

View Full Version : PLEASE HELP, project due today! vba search issues, thanks!



baggins22
12-16-2008, 05:21 PM
I have a large data set, about 15 columns and 500 rows.

I have seen this done before, just dont know how.

its a little hard to exlpain (see example below), but bassicly i would like to create a new worksheet, and have the same 15 coumn titles and i would like to be able to type in creitra in column, push a button, and have the search/retrive all the Rows of the mactching column value.

Ex.
Data Set:

----A---- B----- C
1 --Jeff-- 94---- X
2 --Mike -94---- Z
3 --Fred -34 ----Z
4 --Dan --23 ----Z
5 --Alex --33 ----Z
6 --Frank -66 ----Z

New Worksheet

--A--- B---- C
1
2

So if i where to type "94" in column B, it would return BOTH Jeff and Mikes entire rows (a-c)...or if i were to type "Z" in column C, it would return all the values except row 1

Thanks!!

Kenneth Hobs
12-16-2008, 07:02 PM
It could be done but is it needed? Have you considered Auto Filter? If that doesn't work, you could use Advanced Filter and work from the same sheet.

baggins22
12-16-2008, 07:06 PM
Thanks for the response.

I would like to keep anybody from searching/editing/ etc on the master sheet. Thats why i would like to have a search on a new worksheet

Thnks

Kenneth Hobs
12-16-2008, 08:09 PM
I hide a Slave sheet to copy the Master sheet's data and the Criterion sheet's criterion and used the Advanced filter on that sheet. The filtered range was then copied to the Criterion's sheet. See the attachment for details.

In the code for the Criterion sheet:
Private Sub CommandButton1_Click()
'speed routines at 'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
Dim nbr As Long
On Error GoTo EndSub
SpeedOn

Worksheets("Slave").Cells.Delete
Worksheets("Master").UsedRange.Copy Worksheets("Slave").Range("A1")
nbr = LastNBRow(Worksheets("Slave").UsedRange)
Worksheets("Slave").Range("A1:C" & nbr).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("Criterion").Range("A1:C2"), _
CopyToRange:=Worksheets("Slave").Range("A" & nbr + 2), Unique:=False
Worksheets("Criterion").Range("A6:C" & LastNBRow(Worksheets("Criterion").UsedRange)).ClearContents
Worksheets("Slave").Range("A" & nbr + 2, _
"C" & LastNBRow(Worksheets("Slave").UsedRange)).Copy _
Worksheets("Criterion").Range("A6")

EndSub:
SpeedOff
End Sub

The code for the LastNBRow() function in a module is:
'=LastNBRow(A3:G10)
Function LastNBRow(rng As Range) As Long
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = rng.Find(What:="*", After:=rng.Cells(rng.Rows.Count, rng.Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
LastNBRow = LastRow
End Function