search and deliver
 

I am trying to develop a little VBA lookup program and don't know how
to start:

I have a list of 10 columns
column A will be the column to search through,
Colmn A could also have more than one value that is the same
An input box pops up, the user puts in a value and the program will
search column A find the criteria and then copy and paste the row to
another sheet, continue searching the column, find another match, copy
and paste the row to that other sheet into the next open row.
How does somebody start writing something like this

search and deliver
 

goto the vba help and look for FINDNEXT

--
Don Guillett
SalesAid Software

"damorrison" wrote in message
ups.com...
I am trying to develop a little VBA lookup program and don't know how
to start:

I have a list of 10 columns
column A will be the column to search through,
Colmn A could also have more than one value that is the same
An input box pops up, the user puts in a value and the program will
search column A find the criteria and then copy and paste the row to
another sheet, continue searching the column, find another match, copy
and paste the row to that other sheet into the next open row.
How does somebody start writing something like this

search and deliver
 

Here is an example using Find/Findnext: http://cjoint.com/?dfs7jLddaF

HTH
--
AP

"damorrison" a écrit dans le message de
ups.com...
I am trying to develop a little VBA lookup program and don't know how
to start:

I have a list of 10 columns
column A will be the column to search through,
Colmn A could also have more than one value that is the same
An input box pops up, the user puts in a value and the program will
search column A find the criteria and then copy and paste the row to
another sheet, continue searching the column, find another match, copy
and paste the row to that other sheet into the next open row.
How does somebody start writing something like this

search and deliver
 

Thanks alot for the example, it is exactly what I have been trying to
come up with; there seems to be a glitch though,
when there is only one item, it copies and pastes that item twice.



Sub SearchAndDeliver()

Dim what As String
Dim lastcol As Long
Dim searchRng As Range
Dim FirstFound As Range
Dim NextFound As Range
Dim dest As Range
Sheets("Sheet2").Select
ActiveCell.Cells.Select
Selection.ClearContents
Sheets("Sheet1").Select
ActiveCell.Offset(-4, 0).Range("A1").Select

'Input data to search
what = InputBox("Enter Name", "Search & Deliver")
If what = "" Then Exit Sub

'Initialize src data
With Worksheets("sheet1")
'Set search range
Set searchRng = .Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp) _
)
'calculate last col to move
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Initialize dest data
With Worksheets("Sheet2")
Set dest = .Cells(Rows.Count, "A").End(xlUp)
If dest.Value < "" Then Set dest = dest.Offset(1, 0)
End With

'Start searching
Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
FirstFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=FirstFound)
'Loop until done
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

search and deliver
 

Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
set NextFound = FirstFound
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

--
Regards,
Tom Ogilvy


"damorrison" wrote in message
oups.com...
Thanks alot for the example, it is exactly what I have been trying to
come up with; there seems to be a glitch though,
when there is only one item, it copies and pastes that item twice.



Sub SearchAndDeliver()

Dim what As String
Dim lastcol As Long
Dim searchRng As Range
Dim FirstFound As Range
Dim NextFound As Range
Dim dest As Range
Sheets("Sheet2").Select
ActiveCell.Cells.Select
Selection.ClearContents
Sheets("Sheet1").Select
ActiveCell.Offset(-4, 0).Range("A1").Select

'Input data to search
what = InputBox("Enter Name", "Search & Deliver")
If what = "" Then Exit Sub

'Initialize src data
With Worksheets("sheet1")
'Set search range
Set searchRng = .Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp) _
)
'calculate last col to move
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Initialize dest data
With Worksheets("Sheet2")
Set dest = .Cells(Rows.Count, "A").End(xlUp)
If dest.Value < "" Then Set dest = dest.Offset(1, 0)
End With

'Start searching
Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
FirstFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=FirstFound)
'Loop until done
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

search and deliver
 

You're quite right!
(not fully tested)

Thanks,
--
AP

"Tom Ogilvy" a écrit dans le message de
...
Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
set NextFound = FirstFound
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

--
Regards,
Tom Ogilvy


"damorrison" wrote in message
oups.com...
Thanks alot for the example, it is exactly what I have been trying to
come up with; there seems to be a glitch though,
when there is only one item, it copies and pastes that item twice.



Sub SearchAndDeliver()

Dim what As String
Dim lastcol As Long
Dim searchRng As Range
Dim FirstFound As Range
Dim NextFound As Range
Dim dest As Range
Sheets("Sheet2").Select
ActiveCell.Cells.Select
Selection.ClearContents
Sheets("Sheet1").Select
ActiveCell.Offset(-4, 0).Range("A1").Select

'Input data to search
what = InputBox("Enter Name", "Search & Deliver")
If what = "" Then Exit Sub

'Initialize src data
With Worksheets("sheet1")
'Set search range
Set searchRng = .Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp) _
)
'calculate last col to move
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Initialize dest data
With Worksheets("Sheet2")
Set dest = .Cells(Rows.Count, "A").End(xlUp)
If dest.Value < "" Then Set dest = dest.Offset(1, 0)
End With

'Start searching
Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
FirstFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=FirstFound)
'Loop until done
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

search and deliver
 

Thats it,
I got it going, thanks alot guys