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

goto the vba help and look for FINDNEXT

--
Don Guillett
SalesAid Software
[email protected]
"damorrison" <[email protected]> wrote in message
news:[email protected]...
>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
>

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

HTH
--
AP

"damorrison" <[email protected]> a écrit dans le message de
news:[email protected]...
> 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
>

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

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" <[email protected]> wrote in message
news:[email protected]...
> 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
>

You're quite right!
(not fully tested)

Thanks,
--
AP

"Tom Ogilvy" <[email protected]> a écrit dans le message de
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
> > 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
> >
>
>

Thats it,
I got it going, thanks alot guys