Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 91
Default 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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 718
Default 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



  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 91
Default 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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default 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





  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 718
Default 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





  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 91
Default search and deliver

Thats it,
I got it going, thanks alot guys

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Functions (search within search result) reply to this please Nick Excel Worksheet Functions 1 February 17th 09 03:57 AM
deliver rosta 5 staff x 35hrs cover 24hrs p.a. ninobruno Excel Discussion (Misc queries) 1 September 6th 06 09:00 PM
How do I search excel spreadsheets using multiple search criteria. Kasper Excel Worksheet Functions 4 December 15th 05 12:26 AM
Can VLOOKUP deliver the second occurence when target column entri. IdeaRat Excel Worksheet Functions 3 April 1st 05 07:08 PM
Create a search Field within a worksheet to search command buttons Ed P[_2_] Excel Programming 1 December 14th 04 08:04 PM


All times are GMT +1. The time now is 06:36 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"